View Full Version : Calculate Business Days - No Holiday Table Needed (including MLK day)


KeithG
08-07-2007, 09:21 AM
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

ajetrumpet
10-03-2008, 08:57 AM
Here is another function to calculate the number of BUSINESS DAYS between two dates: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 = YOUR START DATE
dteEnd = YOUR END DATE

NonBusinessDayCounter = 0

TotalActualDays = (dteEnd - dteStart) + 1

Do

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

'New Years Day (January 1st)
ElseIf dteStart = DateSerial(Right(dteStart, 4), 1, 1) Then
NonBusinessDayCounter = NonBusinessDayCounter + 1

'Martin Luther King Day (3rd Monday in January)
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

'Memorial Day (Last Monday in May)
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

'Independence Day (July 4th)
ElseIf dteStart = DateSerial(Right(dteStart, 4), 7, 4) Then
NonBusinessDayCounter = NonBusinessDayCounter + 1

'Labor Day (First Monday in September)
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

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

'Thanksgiving (4th Thursday in November)
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

'Christmas Day (December 25th)
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 FunctionIn addition to the above function, the following function calculates the number of WEEKDAYS between two dates: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 = YOUR START DATE
dteEnd = YOUR END DATE

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