Calculating number of days excluding holidays

[hoop]

I need to calculate the number of days that will be entered into two field StartDate and EndDate. The problem that I am having is that statutory holidays like Christmas, Easter, Thanksgiving, etc.., should not be included in the number of days. For example if the user enters in the StartDate field Dec, 20, 2002 and in the EndDate enters Dec 29, 2002, I do not want to count Christmas and Boxing day, so therefore it will only count 8 days (instead of 10). Any suggestions would help. Thanks

[GMan_NC]

I have a table in my database in which the administrator inputs holiday information for the upcoming year. I do this for vacation requests in my human resource software. When someone enters the dates that you stated above, my software checks to see if there is a date in my holiday table that falls in between these two dates. Example Function

Public Function CheckHoliday(FirstDate As Date, SecondDate As Date) As Integer
On Error GoTo Err_Check
Dim rstHol As ADODB.Recordset
Set rstHol = New ADODB.Recordset
strsql = "SELECT Count(HolDate) as HolCount FROM tblHolidays WHERE HolDate >= '" & FirstDate & "' AND HolDate <= '" & SecondDate & "'"
rstHol.Open strsql, cnn, adOpenStatic, adLockReadOnly
CheckHoliday = rstHol!HolCount
rstHol.Close
Exit_Check:
Set rstHol = Nothing
Exit Function
Err_Check:
MsgBox Err.Description, vbCritical, "Checking Holidays " &
Err.Number
CheckHoliday = 0
Resume Exit_Check
End Function

[OnErr0r]

Can you say Easter Algo? *hehe* Public Function Easter(ByVal lYear As Long) As Date Dim a As Long, b As Long, c As Long, d As Long Dim e As Long, g As Long, h As Long, j As Long, k As Long Dim l As Long, m As Long, n As Long, p As Long a = lYear Mod 19 b = lYear \ 100 c = lYear Mod 100 d = b \ 4 e = b And 3 g = ((8 * b) + 13) \ 25 h = ((19 * a) + b - d - g + 15) Mod 30 j = c \ 4 k = c And 3 m = (a + (11 * h)) \ 319 l = ((2 * e) + (2 * j) - k - h + m + 32) Mod 7 n = (h - m + l + 90) \ 25 p = (h - m + l + n + 19) And 31 Easter = DateSerial(lYear, n, p) End Function Sorry.. I couldn't resist :p

[Robby]

And I thought the date of Easter was determined arbitrarily. :)

Good stuff OnErr0r.

[Chad]

OnErr0r:
How would you modify this to work for Thanksgiving?
Can you tell us what a, b, c, ... are?

[Chad]

This is all I've been able to come up with for Thanksgiving.. anyone see any problems with this?
Function Thanksgiving(ByVal dDate As Date) As Boolean
If DatePart("m", dDate) = 11 Then
If DatePart("w", dDate) = 5 Then
If DatePart("d", dDate) >= 23 Then Thanksgiving = True
End If
End If
End Function

[Chad]

AH.. Got it:
Finally... here's code that will calculate the number of elapsed work days between two dates. It will account for New Years, Memorial Day, July 4th, Labor Day, Thanksgiving and Christmas as well as all Saturdays and Sundays.
The code is also listed for Easter .. though you don't need it because it's on Sunday which is already counted.
To use it you simply:
iElapsedDays=workdays(#11/20/2003#,#11/27/2003#)
This would result in iElapsedDays = 4 which is correct since Thanksgiving falls in that range.
Also resulting in 4 work days:
workdays(#11/22/2003#,#11/29/2003#) - 22nd is Saturday so toss out 3 WE days and 1 holiday = 7-3=4
workdays(#11/21/2003#,#11/29/2003#) - you don't count the day you begin on for elapsed stats so again 7-3=4
workdays(#11/21/2003#,#11/30/2003#) - 30'th is a WE so 8 - 3 WE days - 1 Holiday =4
workdays(#11/21/2003#,#11/28/2003#) - 7days - 2 WE days - 1 Holiday =4


workdays(#11/17/2003#,#11/22/2003#) = 4 Elapsed days. 5 - 1 WE day = 4
workdays(#11/16/2003#,#11/22/2003#) = 5 Elapsed days because Monday is day 1.. so 6 - 1 WE days = 5... we only count 1 WE day because the 16th is the starting day, which is never counted for elapsed days.



Function WorkDays(BegDate As Date, EndDate As Date) As Integer
WorkDays = (DateDiff("d", BegDate, EndDate)) - Holidays(BegDate, EndDate)
End Function

Public Function Holidays(ByVal BegDate As Date, ByVal EndDate As Date) As Integer
Dim HolidayCount As Integer
Dim iDays As Integer
Dim iDay As Integer
Dim dCurrDate As Date
iDays = DateDiff("d", BegDate, EndDate)
For iDay = 1 To iDays
dCurrDate = DateAdd("d", iDay, BegDate)
'Only interested in Week Days
If WeekDay(dCurrDate) > 1 And WeekDay(dCurrDate) < 7 Then
'--------------------
'New Years Day
If DatePart("y", dCurrDate) = 1 Then HolidayCount = HolidayCount + 1
'--------------------
'EASTER - Not needed but man is it cool
' Also note that it will never count Easter because it's on SUNDAY.
' If lYear <= 0 Then
' Dim dEaster As Date
' lYear = DatePart("yyyy", dCurrDate)
' Dim lYear As Long
' Dim a As Long, b As Long, c As Long, d As Long
' Dim e As Long, g As Long, h As Long, j As Long, k As Long
' Dim l As Long, m As Long, n As Long, p As Long
'
' a = lYear Mod 19
' b = lYear \ 100
' c = lYear Mod 100
' d = b \ 4
' e = b And 3
' g = ((8 * b) + 13) \ 25
' h = ((19 * a) + b - d - g + 15) Mod 30
' j = c \ 4
' k = c And 3
' m = (a + (11 * h)) \ 319
' l = ((2 * e) + (2 * j) - k - h + m + 32) Mod 7
' n = (h - m + l + 90) \ 25
' p = (h - m + l + n + 19) And 31
' dEaster = DateSerial(lYear, n, p)
' End If
' If dCurrDate = dEaster Then HolidayCount = HolidayCount + 1
'--------------------
'Memorial Day
If DatePart("m", dCurrDate) = 5 Then
If DatePart("w", dCurrDate) = 2 Then
If CLng(DatePart("d", dCurrDate) / 7) = 4 Then HolidayCount = HolidayCount + 1
End If
End If

'--------------------
'Independance Day
If DatePart("m", dCurrDate) = 7 Then
If DatePart("d", dCurrDate) = 4 Then HolidayCount = HolidayCount + 1
End If
'--------------------
'Labor Day
If DatePart("m", dCurrDate) = 9 Then
If DatePart("w", dCurrDate) = 2 Then
If CLng(DatePart("d", dCurrDate) / 7) < 1 Then HolidayCount = HolidayCount + 1
End If
End If
'--------------------
'THANKSGIVING
If DatePart("m", dCurrDate) = 11 Then
If DatePart("w", dCurrDate) = 5 Then
If DatePart("d", dCurrDate) >= 23 Then HolidayCount = HolidayCount + 1
End If
End If
'--------------------
'CHRISTMAS
If DatePart("m", dCurrDate) = 12 Then
If DatePart("d", dCurrDate) = 25 Then HolidayCount = HolidayCount + 1
End If
Else
'Weekend Day
HolidayCount = HolidayCount + 1
End If
Next
Holidays = HolidayCount
End Function

[OnErr0r]

Looks like maybe you have it. Here is one I use to calculate the exact day of Thanksgiving:


Function Thanksgiving() As Date
Dim d As Long
Dim lYear As Long
Dim dom As Long

lYear = year(Now)
dom = 22 ' start on the earliest possible date
Do
d = WeekDay("11/" & dom & "/" & lYear)
If d <> 5 Then dom = dom + 1
Loop While d <> 5
Thanksgiving = "11/" & dom & "/" & lYear
End Function


You've got the 23, and I think Thanksgiving 2001 was on the 22nd. That should be the earliest possible date.

[Chad]

I thought it was the 23rd? Can't Thanksgiving be on the 27th? Hmm.. you're probably right. Thanks!

[OnErr0r]

27th? Yes it can be, this year in fact and 2008 as well. Last year was the highest date, the 28th My algo starts at 22 and goes until a thursday is encountered. Should be the 4th Thursday in November. :)

[waldot]

In fact, it's my 50th birthday this year.

Thanks for the VB Code on holidays. I'm a VB dabbler and newbie, but I actually programmed this entire thing in the Wordperfect macro language Perfectscript a few years ago. Just for fun.

[Wamphyri]

Unless you are north of the 49th parallel. ;)
In which case it is much simpler

Dim lngTDay As Long
lngTDay = Weekday(CDate("Oct 1," & Year(Now)))
If lngTDay > 2 Then
lngTDay = 17 - lngTDay
Else
lngTDay = 10 - lngTDay
End If
Debug.Print lngTDay