How can I get the ISO week number of some date in VBScript or VBA?
First, note that:
It is important to report the week year along with the week number, as the date's year could be different.
Several Windows components contain a bug for some years' last Monday.
In my experience the simplest, clearest and most robust way to compute this is:
Sub WeekNum(someDate, isoWeekYear, isoWeekNumber, isoWeekDay)
Dim nearestThursday
isoWeekDay = WeekDay(someDate, vbMonday)
nearestThursday = DateAdd("d", 4 - Int(isoWeekDay), someDate)
isoWeekYear = Year(nearestThursday)
isoWeekNumber = Int((nearestThursday - DateSerial(isoWeekYear, 1, 1)) / 7) + 1
End Sub
This also returns the ISO day of the week, counting from 1 for Mondays.
Enter any date into A1 cell, then run following code...
Range("A2").FormulaR1C1 = "=INT((R1C-DATE(YEAR(R1C-WEEKDAY(R1C-1)+4),1,3)+WEEKDAY(DATE(YEAR(R1C-WEEKDAY(R1C-1)+4),1,3))+5)/7)"
You can get it via DatePart() VBA function:
Sub IsoWeek()
Dim isoWeekNum As Byte
Dim myDate As Date
myDate = DateValue("01-01-2022")
isoWeekNum = DatePart("ww", myDate, vbMonday, vbFirstFourDays)
If isoWeekNum > 52 Then ' Bug check (to avoid the bug with Mondays)
If Format(myDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then isoWeekNum = 1
End If
Debug.Print isoWeekNum
End Sub
Related
I've limited knowledge in coding with VBA in Excel and have run into a problem. I'm trying to write a code where it does something based on what day of the week it is.
I'm extracting the day of the week as string and then using a IF...ELSE bit. Code is attached below:
Sub Schedule()
Dim Today As String
Today = Format(Date, "dddd")
If Today >= "Monday" And Today <= "Thursday" Then
'code to do something
ElseIf Today = "Friday" Then
'code to do something
ElseIf Today >= "Saturday" And Today <= "Sunday" Then
'code to do something
End If
End Sub
Kindly advise.
A Select Case ... is fine for this - and do use constants, not magic numbers:
Sub Schedule()
Select Case Weekday(Date)
Case vbMonday To vbThursday
' Code to do something.
Case vbFriday
' Code to do something else.
Case vbSaturday, vbSunday
' Code to do some fun.
End Select
End Sub
Use WeekDay() to extract an integer representing the current day of the week:
Dim Today As VbDayOfWeek
Today = Weekday(Date)
If Today >= vbMonday And Today <= vbThursday Then
....
You cannot apply comparison operands (> or <) to strings so you will need to use the .WeekDay() function instead of formatting to string.
Here is the documentation: WeekDay please note the second optional parameter.
Here is the code:
Dim Today as Long
Today = WeekDay(Date)
If Today >= 2 And Today <= 5 Then
'do something
ElseIf Today = 6 Then
'do something
ElseIf Today = 7 Or Today = 1 Then
'do something
End If
Looking to change this Microsoft Word VBA Code so that the expiration date is always every Monday of the week, not a specific date:
Sub MyMacro()
ExpirationDate = #6/1/2013#
If Now() < ExpirationDate Then
'Rest of macro goes here
End if
End Sub
Any thoughts on how to do this would be great :)
If Weekday(Date) = 2 Then ... 'Monday
Public Function FindMonday(dt As Date) As Date
Do Until WeekdayName(Weekday(dt)) = "Monday"
dt = DateAdd("d", 1, dt)
Loop
FindMonday = dt
End Function
ExpirationDate = (Date + 7) - (Weekday(Date) - Weekday(vbMonday))
This formula will always return the date of next Monday, as specified by "+7"
You don't need to declare the variable Expirationdate.
If Date < (Date + 7) - (Weekday(Date) - Weekday(vbMonday)) Then
will do the job.
Note that Now returns a date/time value whereas Date returns a date integer. If time is of the essence you would have to add it in. Add 0.5 to the above formula to fix the expiration time on next Monday, 12 noon.
I'd usually use this function:
Public Function PreviousMonday(CurrentDate As Date) As Date
PreviousMonday = CurrentDate - Weekday(CurrentDate - 2)
End Function
You can then call it as:
PreviousMonday(Date()) - would return 24/07/2017 if entered today (28th).
PreviousMonday(CDATE("1 July 2017")) - would return 26/06/2017
PreviousMonday(42430) would return 29/02/2016 (42430 = 1st March 2016).
I want to get the last day of the month.
This is my code. If I want to debug it and compile it to the database it says it has an error in the syntax.
Public Function GetNowLast() As Date
Dim asdfh As Date
asdfh = DateValue("1." _
& IIf(Month(Date) + 1) > 12, Month(Date) + 1 - 12, Month(Date) + 1) _
&"."&IIf(Month(Date)+1)>12 , Year(Date)+1,Year(Date))
asdf = DateAdd("d", -1, asdf)
GetNowLast = asdf
End Function
GD Linuxman,
Let's focus on obtaining the result...:-)
See also: here
The comment by #Scott Craner is spot on ! Though strictly speaking there is no need to use the formatting. (Assuming you want to work with the 'Date' object)
To achieve what you want, setup the function as per below:
Function GetNowLast() as Date
dYear = Year(Now)
dMonth = Month(Now)
getDate = DateSerial(dYear, dMonth + 1, 0)
GetNowLast = getDate
End Function
You can call the function in your code as:
Sub findLastDayOfMonth()
lastDay = GetNowLast()
End Sub
Alternatively, and neater is likely:
Function GetNowLast(inputDate as Date) as Date
dYear = Year(inputDate)
dMonth = Month(inputDate)
getDate = DateSerial(dYear, dMonth + 1, 0)
GetNowLast = getDate
End Function
You can call that function and pass it an input parameter.
Sub findLastDayOfMonth()
lastDay = GetNowLast(Now()) 'Or any other date you would like to know the last day of the month of.
End Sub
See also this neat solution by #KekuSemau
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d1 As String
Set Rng = Range("A2")
d1 = Range("a2").Value2 'put a date in A2 Formatted as date(cell format)
Dim years
Dim months
Dim end_month
years = year(d1)
months = month(d1)
end_month = Day(DateSerial(years, months + 1, 1 - 1)) 'add one month and subtract one day from the first day of that month
MsgBox CStr(end_month), vbOKOnly, "Last day of the month"
End Sub
I realize this is a bit late into the conversation, but there is an already available worksheet function that gives the end of month date, EoMonth().
Pasting into the Immediate Window:
?Format(CDate(WorksheetFunction.EoMonth(Date, 0)), "dd")
Will return the last day of the month based on current date.
As a UDF, it makes sense to give it a default Argument:
Function LastDay(Optional DateUsed As Date) As String
If DateUsed = Null Then DateUsed = Date
LastDay = Format(CDate(WorksheetFunction.EoMonth(DateUsed, 0)), "dd")
Debug.Print LastDay
End Function
If you feed it Arguments, be sure that they are Date Literals (i.e. Enclosed with #s)
LastDay(#3/10#)
Result: 31
LastDay #2/11/2012#
Result: 29 '(A leap Year)
Note the output Data Type is String (not Date) and that the format of the date can be adjusted as needed (Ex: "mm/dd/yyyy" instead of "dd").
If the Date Data Type is needed, use:
Function LastDay(Optional DateUsed As Date) As Date
If DateUsed = 0 Then DateUsed = Date
LastDay = WorksheetFunction.EoMonth(DateUsed, 0)
Debug.Print CDate(LastDay)
End Function
I hope that helps someone.
In short, a great and straightforward approach is to find the first day of the following month and then move backward one day.
Make yourself a little function that does something like this:
Obtain the month and year in question (the one where you want the last day)
Use DateSerial to combine the month and the year, along with the day "1" to get the first day of the month in question.
Use DateAdd to add one month. This will get you the first day of the next month (which is one day after the date you really want).
Use DateAdd again to subtract (move back) one day. This will give you the last day of the month where you started.
Function eom(ByVal input_date As Date) As Date
' take the first day of the month from the input date, add one month,
' then back up one day
eom = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(input_date), Month(input_date), 1)))
End Function
In Access VBA, you can call Excel's EOMonth worksheet function (or almost any of Excel's worksheet methods) is by binding to an Excel application object and a WorksheetFunction object, which can be accomplished in a few ways.
Calling Excel functions with an Late Bound object
The shortest method from Access VBA is with a single line of code using a late-bound object. This example returns the date of the last day of the current month:
MsgBox CreateObject("Excel.Application").WorksheetFunction.EOMonth(Now(), 0)
A more verbose method, as a function:
Function eoMonth_LateBound(dt As Date) As Date
Dim xl As Object
Set xl = CreateObject("Excel.Application")
eoMonth_LateBound = xl.WorksheetFunction.eomonth(dt, 0)
Set xl = Nothing
End Function
An issue with late-bound references is that VBA takes a second to bind the object each time the function is called. This can be avoided by using early binding.
Calling Excel functions with an Early Bound object
If the function is to be used repeatedly, it's more efficient to go with Early Binding and retain the object between calls, for example:
Go Tools > References and add a reference to "Microsoft Excel x.xx Object Library" (use whatever the newest version number is that you have installed).
Add this code in a new module:
Option Compare Database
Option Explicit
Dim xl As Excel.Application
Function eoMonth_EarlyBound(dt As Date) As Date
If xl Is Nothing Then Set xl = New Excel.Application
eoMonth_EarlyBound = xl.WorksheetFunction.eomonth(dt, 0)
End Function
Sub demo()
MsgBox eoMonth_EarlyBound(Now())
MsgBox eoMonth_EarlyBound("4/20/2001")
End Sub
Creating a WorksheetFunction object
If Excel's worksheet functions are to be used lots throughout your code, you could even create a WorksheetFunction object to simplify the calls. For example, this could be a simple way to join multiple strings with TEXTJOIN, or get a response from an API with WEBSERVICE:
Sub Examples()
'requires reference: "Microsoft Excel x.xx Object Library"
Dim xl As Excel.Application, wsf As Excel.WorksheetFunction
Set xl = New Excel.Application
Set wsf = xl.WorksheetFunction
'use EOMONTH to return last date of current month
Debug.Print CDate(wsf.eomonth(Now(), 0))
'use WEBSERVICE return your current IP address from a free JSON API
Debug.Print wsf.WebService("https://api.ipify.org")
'use TEXTJOIN to implode a bunch of values
Debug.Print wsf.TextJoin(" & ", True, "join", "this", , "and", , "that", "too")
'always tidy up your mess when finished playing with objects!
Set wsf = Nothing
Set xl = Nothing
End Sub
Note that these functions may require Excel 2016+ or Excel 365 (aka: Object Library 16.0+.)
Another method I used was:
nMonth = 2
nYear = 2021
lastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)
I'm trying to find the number of weeks between two dates in Excel VBA (with some min/max functionality in between), was getting Type Mismatch error (Run-time error '13') for the following line:
WeeksWorked = Application.WorksheetFunction.RoundDown _
(52 * Application.WorksheetFunction.YearFrac _
(Application.WorksheetFunction.Max(DOH, DateValue("Jan 1, 2012")), _
DateValue("Dec 31, 2012")), 0)
Anyone have any direction as to what I'm doing wrong, it would be greatly appreciated!
Not sure why do you need to use this in VBA, here is something you can try.
In Excel:
Assuming Start Date is in A1, End Date is in A2, then A3,
=(NETWORKINGDAYS(A1,A2))/5
Now that is in the perspective of business days, thus giving 5 day week. If you need 7 day week with regular days,
=WEEKNUM(A3)-WEEKNUM(A2)
The function WEEKNUM() in the Analysis Toolpack addin calculates the correct week number for a given date, if you are in the U.S. The user defined function below will calculate the correct week number depending on the national language settings on your computer.
If you still need to use VBA try this: (as Tim pointed out DateDiff pretty handy.) Or you can even use Evaluate to trigger WEEKNUM.
Option Explicit
Function numWeeks(startDate As Date, endDate As Date)
numWeeks = DateDiff("ww", startDate, endDate)
End Function
Using Evaluate on WEEKNUM:
Function numWeeks(startDate As Range, endDate As Range)
Dim s As Integer, t As Integer
s = Application.Evaluate("=WEEKNUM(" & startDate.Address & ",1)")
t = Application.Evaluate("=WEEKNUM(" & endDate.Address & ",1)")
numWeeks = t - s
End Function
Reference for Excel VBA DataTime Functions
As suggested in the comments you could just do:
debug.print DateDiff("ww", DateValue("Jan 1, 2012"), DateValue("Dec 31, 2012"))
If for some reason you wanted to roll your own you could truncate the quotient of:
| day1 - day2 |
---------------
7
Example code:
Sub test_numWeeks_fn()
Call numWeeks(DateValue("Jan 1, 2012"), DateValue("Dec 31, 2012"))
End Sub
Function numWeeks(d1 As Date, d2 As Date)
Dim numDays As Long
numDays = Abs(d1 - d2)
numWeeks = Int(numDays / 7)
Debug.Print numWeeks
End Function
Result:
52
Try below code :
Sub example()
Dim dob As Date
dob = #7/31/1986#
Dim todaydt As Date
todaydt = Date
Dim numWeek As Long
numWeek = DateDiff("ww", dob, todaydt) ' Difference in weeks
End Sub
I've never done VBA before but a friend has asked for help so I've been working on his project. I'm trying to increment a given date by one day but I'm getting an "Object Required" error in the DateAdd function. As far as I can tell I'm putting in an object (firstDate)...
The date entered,for my testing purposes at least, has been 12/03/2012 in that format.
The Format and CDate functions seem to work fine and parse the date.
Here's the code, I get the error at the line with DateAdd in it.
Sub GetDate()
Dim strDate As String
strDate = InputBox(Prompt:="Enter the first day of the week in dd/mm/yyyy format.", _
title:="First day of the week", Default:="")
If strDate = "" Or strDate = vbNullString Then
Exit Sub
Else
Dim firstDate As Date
firstDate = CDate(Format(strDate, "Short Date"))
'Add to O and 6 after
For inc = 0 To 6 Step 1
Range(Chr(79 + inc) & 1) = firstDate
firstDate = DateAdd(DateInterval.Day, 1, firstDate)
Next
End If
End Sub
Appreciate any help.
You're just trying to increment by one day, right?
firstDate = firstDate + 1
The unit of the Date type is one day. So adding 1 adds one day.
Very well...
DateAdd("d", 1, firstDate)
But: I'm not that fussed if anyone reposts a comment of mine as an answer. I do read the comments as well as the answers. Maybe because I have this habit of suggesting answers in comments...