I am using a function to get dates between 2 sets of dates, it works, however I would like to only get dates that are workdays:
Have tried incorporating Application.WorksheetFunction.WorkDay but I am still getting non workdays in the set of dates - any suggestions?
Original function:
Public Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant
Dim varDates() As Date
Dim lngDateCounter As Long
ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))
For lngDateCounter = LBound(varDates) To UBound(varDates)
varDates(lngDateCounter) = CDate(StartDate)
StartDate = CDate(CDbl(StartDate) 1)
Next lngDateCounter
getDates = varDates
End Function
Trial to exclude non workdays:
Public Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant
Dim varDates() As Date
Dim lngDateCounter As Long
ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))
For lngDateCounter = LBound(varDates) To UBound(varDates)
varDates(lngDateCounter) = CDate(Application.WorksheetFunction.WorkDay(StartDate, 0))
StartDate = CDate(CDbl(StartDate) 1)
Next lngDateCounter
getDates = varDates
End Function
CodePudding user response:
Give this a try:
The collections for holidays (fixed and floating) are initialized with hard coded dates but it would be better if the dates were read from a worksheet or table.
Private mFixedHolidays As Collection
Private mFloatingHolidays As Collection
Public Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant
Dim varDates() As Date
Dim lngDateCounter As Long
ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))
Dim dTotalWorkdays As Long
dTotalWorkdays = 0
Dim dDate As Date
dDate = StartDate
For lngDateCounter = LBound(varDates) To UBound(varDates)
If Not (IsWeekendDay(dDate) Or IsFixedHoliday(dDate) Or IsFloatingHoliday(dDate)) Then
varDates(dTotalWorkdays) = dDate
dTotalWorkdays = dTotalWorkdays 1
End If
dDate = CDate(CDbl(dDate) 1)
Next lngDateCounter
ReDim Preserve varDates(dTotalWorkdays - 1)
getDates = varDates
End Function
Private Function IsWeekendDay(ByVal dateOfInterest As Date) As Boolean
IsWeekendDay = _
Weekday(dateOfInterest) = VbDayOfWeek.vbSaturday _
Or Weekday(dateOfInterest) = VbDayOfWeek.vbSunday
End Function
Private Function IsFixedHoliday(ByVal dateOfInterest As Date) As Boolean
Dim result As Boolean
result = False
If mFixedHolidays Is Nothing Then
Set mFixedHolidays = New Collection
'Year portion of dates will be ignored
With mFixedHolidays
.Add "7/4/2022"
.Add "12/25/2022"
.Add "1/1/2022"
'Add other fixed date holidays
End With
End If
Dim fixedDate As Date
Dim dateToken As Variant
For Each dateToken In mFixedHolidays
fixedDate = DateValue(dateToken)
If Month(fixedDate) = Month(dateOfInterest) And Day(fixedDate) = Day(dateOfInterest) Then
result = True
Exit For
End If
Next
IsFixedHoliday = result
End Function
Private Function IsFloatingHoliday(ByVal dateOfInterest As Date) As Boolean
Dim result As Boolean
result = False
If mFloatingHolidays Is Nothing Then
Set mFloatingHolidays = New Collection
With mFloatingHolidays
.Add "5/30/2022" 'Memorial Day
'Add other floating date holidays
End With
End If
Dim floatingDate As Date
Dim dateToken As Variant
For Each dateToken In mFloatingHolidays
floatingDate = DateValue(dateToken)
If floatingDate = dateOfInterest Then
result = True
Exit For
End If
Next
IsFloatingHoliday = result
End Function