Home > OS >  Get dates between 2 sets of dates excluding non workdays
Get dates between 2 sets of dates excluding non workdays

Time:04-02

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

  • Related