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


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

chergh
10-09-2008, 06:56 AM
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.


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