Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

RFC: Date calculations with US Holidays

Status
Not open for further replies.
CautionMP

CautionMP

Programmer
Dec 11, 2001
1,516
US
I'm re-writting a routine I wrote a couple of years ago that calculates US holidays that's used primarily in MS Excel and Access. The original routine uses static dates to do the calculations so each year it runs a little slower so I figured it was time to re-engineer. I'm lucky in that I'm doing the calculation for a Bank, which is tied to the federal reserve, so it takes an act of US Congress for a holiday to be changed.

I hoping once I finalize this I will NEVER have to look at it again, so I'm looking for as much productive input as possible.

There are four functions:[ol]
[li]IsStandardHoliday(DateToCheck As Date): If the supplied date is a holiday this returns True,
otherwise returns False.[/li]
[li]HolidayInWeek(CurrentMonth As Integer, CurrentYear As Integer, DayOfWeek As Integer,
WeekNumber As Integer): Supports [tt]IsStandardHoliday()[/tt], when supplied a Month, Year, DayOfWeek, and WeekNumber will return a date.[/li]
[li]FederalWorkingDays(Start_Date As Date, End_Date As Date): Essentially a DateDiff()
function that calculates the weekdays excluding standard holidays.[/li]
[li]NetworkDays_Holidays(Start_Date As Date, End_Date As Date): Returns an array of dates
that can be used to feed the [tt]Holidays[/tt] argument of the Excel [tt]Networkdays()[/tt] function. I used
this primarily for testing.[/li][/ol]
Code: 
[navy]Public Function[/navy] IsStandardHoliday(DateToCheck [navy]As Date[/navy]) [navy]As Boolean[/navy]
[green]'Basic check for the ten (10) standard US Federal Holidays using standard
'government/banking rules (holiday on Saturday is not observed, holiday on
'Sunday is observed on Monday)
' *For the seven (7) Weekday holidays (Martin Luther King Jr Day,
'  Presidents Day, Memorial Day, Labor Day, Columbus Day, Veterans Day, and
'  Thanksgiving Day) uses HolidayInWeek() and HolidayOnLast() to find the
'  dynamic date.
' *For the three (3) day specific holidays (New Years Day, Independence Day,
'  and Christmas Day) routine will check the actual WeekDay or the WeekDay
'  after to account for the holiday being observed on the following Monday[/green]
[navy]Select Case[/navy] Month(DateToCheck)
  [navy]Case[/navy] 1
    [green]'New Years Day, January 1st[/green]
    [navy]If[/navy] Day(DateToCheck) = 1 And Weekday(DateToCheck, vbMonday) < 6 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [green]'If New Years day falls on a Sunday check For the Monday push[/green]
    [navy]Else[/navy][navy]If[/navy] Day(DateToCheck) = 2 And Weekday(DateToCheck, vbSunday) = 2 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
    [green]'MartIn Luther King Jr Day, third Monday In January[/green]
    [navy]If Date[/navy]ToCheck = HolidayInWeek(Month(DateToCheck), Year(DateToCheck), _
                     vbMonday, 3) [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 2
    [green]'Presidents Day, third Monday In February[/green]
    [navy]If Date[/navy]ToCheck = HolidayInWeek(Month(DateToCheck), Year(DateToCheck), _
                     vbMonday, 3) [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 3
    [green]'No Holidays[/green]
  [navy]Case[/navy] 4
    [green]'No Holidays[/green]
  [navy]Case[/navy] 5
    [green]'Memorial Day, last Monday In May[/green]
    [navy]If Date[/navy]ToCheck = HolidayInWeek(Month(DateToCheck), Year(DateToCheck), _
                     vbMonday, -1) [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 6
    [green]'No Holidays[/green]
  [navy]Case[/navy] 7
    [green]'Independence Day[/green]
    [navy]If[/navy] Day(DateToCheck) = 4 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]Else[/navy][navy]If[/navy] Day(DateToCheck) = 5 And Weekday(DateToCheck, vbSunday) = 2 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 8
    [green]'No Holidays[/green]
  [navy]Case[/navy] 9
    [green]'Labor Day, first Monday In September[/green]
    [navy]If Date[/navy]ToCheck = HolidayInWeek(Month(DateToCheck), Year(DateToCheck), _
                     vbMonday, 1) [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 10
    [green]'Columbus Day, second Monday In October[/green]
    [navy]If Date[/navy]ToCheck = HolidayInWeek(Month(DateToCheck), Year(DateToCheck), _
                     vbMonday, 2) [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 11
    [green]'Veterans Day, November 11th[/green]
    [navy]If[/navy] Day(DateToCheck) = 11 And Weekday(DateToCheck, vbMonday) < 6 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]Else[/navy][navy]If[/navy] Day(DateToCheck) = 12 And Weekday(DateToCheck, vbSunday) = 2 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
    [green]'Thanksgiving Day, third Thursday In November[/green]
    [navy]If Date[/navy]ToCheck = HolidayInWeek(Month(DateToCheck), Year(DateToCheck), _
                     vbThursday, 3) [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
  [navy]Case[/navy] 12
    [green]'Christmas Day, December 25th[/green]
    [navy]If[/navy] Day(DateToCheck) = 25 And Weekday(DateToCheck, vbMonday) < 6 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]Else[/navy][navy]If[/navy] Day(DateToCheck) = 26 And Weekday(DateToCheck, vbSunday) = 2 [navy]Then[/navy]
      IsStandardHoliday = [navy]True[/navy]
    [navy]End If[/navy]
[navy]End Select[/navy]
[navy]End Function[/navy]

[navy]Public Function[/navy] HolidayInWeek(CurrentMonth [navy]As Integer[/navy], _
CurrentYear [navy]As Integer[/navy], DayOfWeek [navy]As Integer[/navy], _
WeekNumber [navy]As Integer[/navy]) [navy]As Date[/navy]
[green]'WeekNumber 1 - 5 is a specific week[/green]
[green]'WeekNumber -1 is the last week of the month[/green]
[navy]If[/navy] DayOfWeek < 1 [navy]Or[/navy] DayOfWeek > 7 [navy]Or[/navy] WeekNumber > 5 [navy]Or[/navy] _
   WeekNumber = 0 [navy]Or[/navy] WeekNumber < -1 [navy]Then[/navy]
  MsgBox "Invalid Day or Week", vbCritical, "HolidayInWeek Error"
  HolidayInWeek = -1
  [navy]Exit Function[/navy]
[navy]End If[/navy]
[navy]Dim[/navy] dteTemp [navy]As Date[/navy]
[navy]If[/navy] Sgn(WeekNumber) = -1 [navy]Then[/navy]
  [green]'In last week of month[/green]
  dteTemp = DateSerial(CurrentYear, CurrentMonth + 1, "1") - 1
  HolidayInWeek = dteTemp - (Weekday(dteTemp, vbSunday) - DayOfWeek)
[navy]Else[/navy]
  [green]'In specific WeekNumber[/green]
  dteTemp = [navy]Date[/navy]Serial(CurrentYear, CurrentMonth, "1")
  [navy]If[/navy] DayOfWeek < Weekday(dteTemp, vbSunday) [navy]Then[/navy]
    HolidayInWeek = dteTemp + (DayOfWeek - Weekday(dteTemp, vbSunday)) _
                    + (7 * WeekNumber)
  [navy]Else[/navy]
    HolidayInWeek = dteTemp + (DayOfWeek - Weekday(dteTemp, vbSunday)) _
                    + (7 * (WeekNumber - 1))
  [navy]End If[/navy]
[navy]End If[/navy]
[navy]End Function[/navy]

[navy]Public Function[/navy] FederalWorkingDays(Start_Date [navy]As Date[/navy], End_Date As [navy]Date[/navy])
[navy]As Long[/navy]
[navy]Dim[/navy] dteCounter [navy]As Date[/navy]
[navy]Dim[/navy] intStep [navy]As Integer[/navy]
[green]'Determine If the return will be positive or negative[/green]
[navy]If[/navy] Int(Start_Date) <= Int(End_Date) [navy]Then[/navy]
  FederalWorkingDays = 0
  [navy]Exit Function[/navy]
[navy]ElseIf[/navy] Int(Start_Date) <= Int(End_Date) [navy]Then[/navy]
  intStep = 1
Else
  intStep = -1
[navy]End If[/navy]
[green]'Loop through the days[/green]
[navy]For[/navy] dteCounter = Int(Start_Date) [navy]To[/navy] Int(End_Date) [navy]Step[/navy] intStep
  [green]'Check If weekday (not sure If Mod will run faster than Weekday())[/green]
  [navy]If[/navy] dteCounter Mod 7 > 1 [navy]Then[/navy]
    [green]'It's a weekday so check For standard holidays[/green]
    [navy]If Not[/navy] IsStandardHoliday(dteCounter) [navy]Then[/navy]
      FederalWorkingDays = FederalWorkingDays + intStep
    [navy]End If[/navy]
  [navy]End If[/navy]
[navy]Next[/navy] dteCounter
[navy]End Function[/navy]

[navy]Public Function[/navy] NetworkDays_Holidays(Start_Date [navy]As Date[/navy], End_Date [navy]As Date[/navy])
[navy]As String[/navy]()
[navy]Dim[/navy] dteCounter [navy]As Date[/navy]
[navy]Dim[/navy] intStep [navy]As Integer[/navy]
[navy]Dim[/navy] strTemp [navy]As String[/navy]
[green]'Determine If the return will be positive or negative[/green]
[navy]If[/navy] Int(Start_Date) = Int(End_Date) [navy]Then[/navy]
  [navy]GoTo[/navy] Exit_Function
[navy]ElseIf[/navy] Int(Start_Date) <= Int(End_Date) [navy]Then[/navy]
  intStep = 1
[navy]Else[/navy]
  intStep = -1
[navy]End If[/navy]
[green]'Loop through the days[/green]
[navy]For[/navy] dteCounter = Int(Start_Date) [navy]To[/navy] Int(End_Date) [navy]Step[/navy] intStep
  [green]'Only check weekdays[/green]
  [navy]If[/navy] dteCounter Mod 7 > 1 [navy]Then[/navy]
    [green]'It[green]'s a weekday so check For standard holidays[/green]
    [navy]If[/navy] IsStandardHoliday(dteCounter) [navy]Then[/navy]
      [green]'add a delimiter If the strTemp hAs a value[/green]
      [navy]If[/navy] Len(strTemp) > 0 [navy]Then[/navy]
        strTemp = strTemp & ","
      [navy]End If[/navy]
      [green]'add the currnt Date To the list[/green]
      strTemp = strTemp & dteCounter
    [navy]End If[/navy]
  [navy]End If[/navy]
[navy]Next[/navy] dteCounter
Exit_Function:
[green]'We have To supply a value otherwise Networkdays retrns an Error[/green]
[navy]If[/navy] Len(strTemp) = 0 [navy]Then[/navy]
  strTemp = 1
[navy]End If[/navy]
[green]'Set the return Array[/green]
NetworkDays_Holidays = Split(strTemp, ",")
[navy]End Function[/navy]

Thanks in advance for any input,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Sort by date Sort by votes
Is there a mistake here:
Code: 
Public Function FederalWorkingDays(Start_Date As Date, End_Date As Date)
As Long
Dim dteCounter As Date
Dim intStep As Integer
'Determine If the return will be positive or negative
If Int(Start_Date) [b]<=[/b] Int(End_Date) Then
  FederalWorkingDays = 0
  Exit Function
ElseIf Int(Start_Date) <= Int(End_Date) Then
  intStep = 1
Else
  intStep = -1
End If
... you have "<=" for the first 2 parts of the If block structure.



Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.
 
Upvote 0 Downvote
Can I ask - isn't FederalWorkingDays actually the same as NetWorkdays ( in the Analysis Toolpak )?


Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.
 
Upvote 0 Downvote
GlennUK,
To your first post: Yes, it's a mistake in the first part of the block.

To your second post: Yes, the result should be the same if you feed all the holiday arguments to [tt]Networkdays()[/tt]. Since the routine will be used in Access as well I can't rely on the Excel functions.

Thanks for the sharp eyes,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Upvote 0 Downvote
Glad the sharp eyes did their job well last week. Will have another read of the code at lunchtime in case anything else jumps out at me.



Cheers, Glenn.

Did you hear about the literalist show-jumper? He broke his nose jumping against the clock.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Helpful tip
Calculate Week Number - Week in Month - Holidays
Replies
0
Views
426
remeng
remeng
aldi07
  • Locked
  • Question
update a front-end databases with a new release using vba
Replies
2
Views
388
aldi07
aldi07
gussy81
  • Locked
  • Question
mail merge with attachments 2
2
Replies
20
Views
1K
Andrzejek
Andrzejek
office365
  • Locked
  • Question
i have a problem with a button sele 2
Replies
15
Views
815
combo
combo
osera
  • Locked
  • Question
Delete file from Sharepoint with Access VBA
Replies
2
Views
585
osera
osera

Part and Inventory Search

Sponsor

Back
Top