Calculate Business Days - No Holiday Table Needed (including MLK day) (1 Viewer)

Status
Not open for further replies.
KeithG

KeithG

AWF VIP
Local time
Today, 00:18
Joined
Mar 23, 2006
Messages
2,592
Calculate Business Days - No Holiday Table Needed

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

    Dim lngYear As Long
    Dim lngEYear As Long
    Dim dteStart As Date, dteEnd As Date
    Dim dteCurr As Date
    Dim lngDay As Long
    Dim lngDiff As Long
    Dim lngACount As Long
    Dim dteLoop As Variant
    Dim blnHol As Boolean
    Dim dteHoliday() As Date
    Dim lngCount As Long, lngTotal As Long
    Dim lngThanks As Long
    
    dteStart = dteStartDate
    dteEnd = dteEndDate
    
    lngYear = DatePart("yyyy", dteStart)
    lngEYear = DatePart("yyyy", dteEnd)
    
    If lngYear <> lngEYear Then
        lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
        ReDim dteHoliday(lngDiff)
    Else
        ReDim dteHoliday(6)
    End If
    
    lngACount = -1
    
    For lngCount = lngYear To lngEYear
        lngACount = lngACount + 1
        'July Fourth
        dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)
    
        lngACount = lngACount + 1
        'Christmas
        dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)
    
        lngACount = lngACount + 1
        'New Years
        dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)
    
        lngACount = lngACount + 1
        'Thanksgiving - 4th Thursday of November
        lngDay = 1
        lngThanks = 0
        Do
            If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
                lngThanks = lngThanks + 1
            End If
            lngDay = lngDay + 1
        Loop Until lngThanks = 4
        
        dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)
        
        lngACount = lngACount + 1
        'Memorial Day - Last Monday of May
        lngDay = 31
        Do
            If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
                dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
            Else
                lngDay = lngDay - 1
            End If
        Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)
    
        lngACount = lngACount + 1
        'Labor Day - First Monday of Septemeber
        lngDay = 1
        Do
            If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
                dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
            Else
                lngDay = lngDay + 1
            End If
        Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
        'MsgBox dteHoliday(5)
        
        lngACount = lngACount + 1
       'Easter
        lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21
    
        dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
                (lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
                lngDay + (lngDay > 48) + 1) Mod 7)
    Next
        
          
     For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
        dteCurr = (dteStart + lngCount)
        If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
            blnHol = False
            For dteLoop = 0 To UBound(dteHoliday)
            'MsgBox dteHoliday(dteLoop) & "  " & dteLoop
                If (dteHoliday(dteLoop) = dteCurr) Then
                 blnHol = True
                End If
            Next dteLoop
            If blnHol = False Then
                lngTotal = lngTotal + 1
                'MsgBox dteCurr
            End If
        End If
    Next lngCount

BusinessDays = lngTotal
       
End Function
 
Last edited:
ajetrumpet

ajetrumpet

Banned
Local time
Today, 02:18
Joined
Jun 22, 2007
Messages
5,638
Alternate Method

Here is another function to calculate the number of BUSINESS DAYS between two dates:
Code: 
Function BusinessDays()

On Error GoTo ErrorHandler

Dim dteStart As Date, dteEnd As Date
  Dim TotalActualDays As Long, TotalBusinessDays As Long
    Dim NonBusinessDayCounter As Long
      Dim varFunction

DoCmd.Hourglass (-1)

dteStart = [COLOR="Red"]YOUR START DATE[/COLOR]
dteEnd = [COLOR="Red"]YOUR END DATE[/COLOR]

    NonBusinessDayCounter = 0

TotalActualDays = (dteEnd - dteStart) + 1

    Do
        
        If Weekday(dteStart) = 7 Or Weekday(dteStart) = 1 Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'New Years Day (January 1st)[/COLOR]
        ElseIf dteStart = DateSerial(Right(dteStart, 4), 1, 1) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'Martin Luther King Day (3rd Monday in January)[/COLOR]
        ElseIf dteStart = _
             IIf(Weekday("1/15/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/15/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("1/16/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/16/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("1/17/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/17/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("1/18/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/18/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("1/19/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/19/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("1/20/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/20/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("1/21/" & DatePart("yyyy", dteStart)) = 2, _
                         "1/21/" & DatePart("yyyy", dteStart), 0))))))) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'Memorial Day (Last Monday in May)[/COLOR]
        ElseIf dteStart = _
             IIf(Weekday("5/31/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/31/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("5/30/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/30/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("5/29/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/29/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("5/28/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/28/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("5/27/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/27/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("5/26/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/26/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("5/25/" & DatePart("yyyy", dteStart)) = 2, _
                         "5/25/" & DatePart("yyyy", dteStart), 0))))))) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'Independence Day (July 4th)[/COLOR]
        ElseIf dteStart = DateSerial(Right(dteStart, 4), 7, 4) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1
        
        [COLOR="SeaGreen"]'Labor Day (First Monday in September)[/COLOR]
        ElseIf dteStart = _
             IIf(Weekday("9/1/" & DatePart("yyyy", dteStart)) = 2, _
                         "9/1/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("9/2/" & DatePart("yyyy", dteStart)) = 2, _
                         "9/2/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("9/3/" & DatePart("yyyy", dteStart)) = 2, _
                         "9/3/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("9/4/" & DatePart("yyyy", dteStart)) = 2, _
                         "9/4/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("9/5/" & DatePart("yyyy", dteStart)) = 2, _
                         "9/5/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("9/6/" & DatePart("yyyy", dteStart)) = 2, _

                         "9/6/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("9/7/" & DatePart("yyyy", dteStart)) = 2, _
                         "9/7/" & DatePart("yyyy", dteStart), 0))))))) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'Armistice Day/Veterans Day (November 11th)[/COLOR]
        ElseIf dteStart = DateSerial(Right(dteStart, 4), 11, 11) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'Thanksgiving (4th Thursday in November)[/COLOR]
        ElseIf dteStart = _
             IIf(Weekday("11/22/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/22/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("11/23/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/23/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("11/24/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/24/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("11/25/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/25/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("11/26/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/26/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("11/27/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/27/" & DatePart("yyyy", dteStart), _
             IIf(Weekday("11/28/" & DatePart("yyyy", dteStart)) = 5, _
                         "11/28/" & DatePart("yyyy", dteStart), 0))))))) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        [COLOR="SeaGreen"]'Christmas Day (December 25th)[/COLOR]
        ElseIf dteStart = DateSerial(Right(dteStart, 4), 12, 25) Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1

        End If

      dteStart = dteStart + 1

    Loop Until dteStart = dteEnd + 1

  TotalBusinessDays = TotalActualDays - NonBusinessDayCounter
    DoCmd.Hourglass (0)

  MsgBox "The number of business days between your two dates is " & _
               Format(TotalBusinessDays, "###,###,###") & ".", _
               vbOKOnly, "Number of days calculated"

  End If
    Exit Function

ErrorHandler:
  MsgBox "The date range is too large to be evaluated." & _
  vbCr & vbCr & "Please try a different date range."

End Function
In addition to the above function, the following function calculates the number of WEEKDAYS between two dates:
Code: 
Function Weekdays()

On Error GoTo ErrorHandler

Dim dteStart As Date, dteEnd As Date
  Dim TotalActualDays As Long, TotalBusinessDays As Long
    Dim NonBusinessDayCounter As Long
      Dim varFunction

DoCmd.Hourglass (-1)

dteStart = [COLOR="Red"]YOUR START DATE[/COLOR]
dteEnd = [COLOR="Red"]YOUR END DATE[/COLOR]

    NonBusinessDayCounter = 0

TotalActualDays = (dteEnd - dteStart) + 1

      Do
        
        If Weekday(dteStart) = 7 Or Weekday(dteStart) = 1 Then
          NonBusinessDayCounter = NonBusinessDayCounter + 1
        End If

        dteStart = dteStart + 1

      Loop Until dteStart = dteEnd + 1

    TotalBusinessDays = TotalActualDays - NonBusinessDayCounter
      DoCmd.Hourglass (0)

  MsgBox "The number of business days between your two dates is " & _
               Format(TotalBusinessDays, "###,###,###") & ".", _
               vbOKOnly, "Number of days calculated"

  End If
    Exit Function

ErrorHandler:
  MsgBox "The date range is too large to be evaluated." & _
  vbCr & vbCr & "Please try a different date range."

End Function
 
chergh

chergh

blah
Local time
Today, 08:18
Joined
Jun 15, 2004
Messages
1,414
Err your functions don't actually return the value Ajet and would be easier to use in code if they accepted start dates and end dates as parameters. Anyway here's the function I use for returning working days between two dates.

There is no handling for holidays as I just don't find it worth the trouble.

Code: 
Public Function WorkingDays(StartDate As Date, EndDate As Date) As Long


Dim intCount As Long

intCount = 0

Do While StartDate <= EndDate

Select Case Weekday(StartDate)
   Case Is = 1, 7
      intCount = intCount
   Case Is = 2, 3, 4, 5, 6
      intCount = intCount + 1
End Select

StartDate = StartDate + 1

Loop

WorkingDays = intCount

End Function
 
Status
Not open for further replies.

Similar threads

Gasman
nth Day of month
Replies
4
Views
671
ebs17
E
mike60smart
Calculated Total Days Vacation taken
Replies
7
Views
1,283
theDBguy
theDBguy
I
Adding working days to a date, not calculating correctly every time
Replies
6
Views
1,142
Integrate
I
A
FE Database Still Experiencing Bloat
2
Replies
32
Views
1,917
arnelgp
arnelgp
S
Subtracting business days (with holiday table) from a START DATE
2
Replies
30
Views
1,535
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom