Calculate Business Days - No Holiday table needed

Status
Not open for further replies.

KeithG

AWF VIP
Local time
Yesterday, 19:07
Joined
Mar 23, 2006
Messages
2,592
Below is a function I wrote to calcualate business days in a given time frame. The Begining and End date must be in the same year. A co-worker helped with the calculation to determine the date of Easter.

Code:
Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) As Long

    Dim lngYear As Long
    Dim dteStart As Date, dteEnd As Date
    Dim dteCurr As Date
    Dim lngDay As Long
    Dim dteLoop As Variant
    Dim blnHol As Boolean
    Dim dteHoliday(5) As Date
    Dim lngCount As Long, lngTotal As Long
    
    dteStart = dteStartDate
    dteEnd = dteEndDate
    
    lngYear = DatePart("yyyy", dteStart)
    
    'July Fourth
    dteHoliday(0) = DateSerial(lngYear, 7, 4)

    'Christmas
    dteHoliday(1) = DateSerial(lngYear, 12, 25)

    'New Years
    dteHoliday(2) = DateSerial(lngYear, 1, 1)

    'Thanksgiving - Last Thursday of November
    dteHoliday(3) = DateSerial(lngYear, 11, 29 - _
                    Weekday(DateSerial(lngYear, 11, 1), vbFriday))
    
    'Memorial Day - Last Monday of May
    lngDay = 31
    Do
        If Weekday(DateSerial(lngYear, 5, lngDay)) = 2 Then
            dteHoliday(4) = DateSerial(lngYear, 5, lngDay)
        Else
            lngDay = lngDay - 1
        End If
    Loop Until dteHoliday(4) >= DateSerial(lngYear, 5, 1)

    'Labor Day - First Monday of Septemeber
    lngDay = 1
    Do
        If Weekday(DateSerial(lngYear, 9, lngDay)) = 2 Then
            dteHoliday(5) = DateSerial(lngYear, 9, lngDay)
        Else
            lngDay = lngDay + 1
        End If
    Loop Until dteHoliday(5) >= DateSerial(lngYear, 9, 1)
    
   'Easter
    lngDay = (((255 - 11 * (lngYear Mod 19)) - 21) Mod 30) + 21

    dteHoliday(5) = DateSerial(lngYear, 3, 1) + lngDay + _
            (lngDay > 48) + 6 - ((lngYear + lngYear \ 4 + _
            lngDay + (lngDay > 48) + 1) Mod 7)
          
     For lngCount = 0 To (dteEnd - dteStart)
        dteCurr = (dteStart + lngCount)
        If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
            blnHol = False
            For dteLoop = 0 To 5
                If (dteHoliday(dteLoop) = dteCurr) Then blnHol = True
            Next dteLoop
            If blnHol = False Then lngTotal = lngTotal + 1
        End If
    Next lngCount

CountWorkingDays = lngTotal
 
Status
Not open for further replies.

Users who are viewing this thread

Back
Top Bottom