Calculate U.S. holidays for any given year
Add U.S. holidays to your server's holiday list with this code.
This piece of code was written -- just as a starting point -- to perhaps, at some point, add holidays to your server's holiday list. This code is for the U.S. only.
Option Public Option Declare Public Type Holiday Name As String Date As Variant End Type Sub Initialize
'See: http://www.vpcalendar.net/Holiday_Dates/Holiday_Determinations.html
Dim holidays(17) As Holiday Dim tmpString As String Dim tmpDate As Variant Dim wkDay As Integer Dim holidayYear As Integer tmpString = Inputbox$("Enter year for list of USA holidays dates for that year") On Error Goto errHandler holidayYear = Cint(tmpString) tmpString = "" '=================================== holidays(0).Name = "New Year's Day" 'January 1 - Always tmpDate = Dateserial(holidayYear, 1, 1) holidays(0).Date = tmpDate '=================================== '=================================== holidays(1).Name = "Martin Luther King Jr Day" '3rd Monday in January - this means it can fall anywhere between Jan. 15 and Jan. 21 tmpDate = Dateserial(holidayYear, 1, 15) wkDay = Weekday(tmpDate) holidays(1).Date = tmpDate - wkDay + 2 'Subtract the current day, add 2 for Monday If wkDay > 2 Then holidays(1).Date = holidays(1).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(2).Name = "Groundhog Day" 'February 1 - Always tmpDate = Dateserial(holidayYear, 2, 2) holidays(2).Date = tmpDate '=================================== '=================================== holidays(3).Name = "Valentine's Day" 'February 14 - Always tmpDate = Dateserial(holidayYear, 2, 14) holidays(3).Date = tmpDate '=================================== '=================================== holidays(4).Name = "President's Day" '3rd Monday in February - this means it can fall anywhere between Feb. 15 and Feb. 21 tmpDate = Dateserial(holidayYear, 2, 15) wkDay = Weekday(tmpDate) holidays(4).Date = tmpDate - wkDay + 2 'Subtract the current day, add 2 for Monday If wkDay > 2 Then holidays(4).Date = holidays(4).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(5).Name = "St. Patrick's Day" 'March 17 - Always tmpDate = Dateserial(holidayYear, 3, 17) holidays(5).Date = tmpDate '=================================== '=================================== holidays(7).Name = "Easter" holidays(7).Date = dateEaster(holidayYear) '=================================== '=================================== holidays(6).Name = "Good Friday" holidays(6).Date = holidays(7).Date - 2 'Easter Sunday - 2 days for Good Friday '=================================== '=================================== holidays(8).Name = "Mother's Day" '2nd Sunday in May - this means it can fall anywhere between May 8 and May 14 tmpDate = Dateserial(holidayYear, 5, 8) wkDay = Weekday(tmpDate) holidays(8).Date = tmpDate - wkDay + 1 'Subtract the current day, add 1 for Sunday If wkDay > 1 Then holidays(8).Date = holidays(8).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(9).Name = "Memorial Day" 'Last Monday in May - this means it can fall anywhere between May 25 and May 31 tmpDate = Dateserial(holidayYear, 5, 25) wkDay = Weekday(tmpDate) holidays(9).Date = tmpDate - wkDay + 2 'Subtract the current day, add 2 for Monday If wkDay > 2 Then holidays(9).Date = holidays(9).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(10).Name = "Father's Day" '3rd Sunday in June - this means it can fall anywhere between June 15 and June 21 tmpDate = Dateserial(holidayYear, 6, 15) wkDay = Weekday(tmpDate) holidays(10).Date = tmpDate - wkDay + 1 'Subtract the current day, add 1 for Sunday If wkDay > 1 Then holidays(10).Date = holidays(10).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(11).Name = "Independence Day" 'July 4 - Always tmpDate = Dateserial(holidayYear, 7, 4) holidays(11).Date = tmpDate '=================================== '=================================== holidays(12).Name = "Labor Day" '1st Monday in September - this means it can fall anywhere between Sept. 1 and Sept. 7 tmpDate = Dateserial(holidayYear, 9, 1) wkDay = Weekday(tmpDate) holidays(12).Date = tmpDate - wkDay + 2 'Subtract the current day, add 2 for Monday If wkDay > 2 Then holidays(12).Date = holidays(12).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(13).Name = "Columbus Day" '2nd Monday in October - this means it can fall anywhere between Oct. 8 and Oct. 14 tmpDate = Dateserial(holidayYear, 10, 8) wkDay = Weekday(tmpDate) holidays(13).Date = tmpDate - wkDay + 2 'Subtract the current day, add 2 for Monday If wkDay > 2 Then holidays(13).Date = holidays(13).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(14).Name = "Halloween" 'October 31 - Always tmpDate = Dateserial(holidayYear, 10, 31) holidays(14).Date = tmpDate '=================================== '=================================== holidays(15).Name = "Veteran's Day" 'November 11 - Always tmpDate = Dateserial(holidayYear, 11, 11) holidays(15).Date = tmpDate '=================================== '=================================== holidays(16).Name = "Thanksgiving" '4th Thursday in November - this means it can fall anywhere between Nov. 22 and Nov. 28 tmpDate = Dateserial(holidayYear, 11, 22) wkDay = Weekday(tmpDate) holidays(16).Date = tmpDate - wkDay + 5 'Subtract the current day, add 5 for Thursday If wkDay > 5 Then holidays(16).Date = holidays(16).Date + 7 'Add 7 to go to next week End If '=================================== '=================================== holidays(17).Name = "Christmas Day" 'December 25 - Always tmpDate = Dateserial(holidayYear, 12, 25) holidays(17).Date = tmpDate '=================================== Forall h In holidays tmpString = tmpString & Chr(13) & Format(h.Date, "yyyy.mm.dd") & Chr(9) & h.Name End Forall Msgbox Mid$(tmpString, 2), , "USA Holidays for " & Cstr(holidayYear) Goto endFunc errHandler: Msgbox "Invalid year entered" Resume endFunc endFunc: End Sub Function dateEaster(y As Integer) As Variant
'See http://aa.usno.navy.mil/faq/docs/easter.html
Dim c As Integer Dim n As Integer Dim k As Integer Dim i As Integer Dim j As Integer Dim l As Integer Dim m As Integer Dim d As Integer c = y \ 100 n = y - 19 * ( y \ 19 ) k = ( c - 17 ) 25 i = c - c \ 4 - ( c - k ) \ 3 + 19 * n + 15 i = i - 30 * ( i \ 30 ) i = i - ( i \ 28 ) * ( 1 - ( i \ 28 ) * ( 29 \ ( i + 1 ) ) * ( ( 21 - n ) \ 11 ) ) j = y + y 4 + i + 2 - c + c \ 4 j = j - 7 * ( j \ 7 ) l = i - j m = 3 + ( l + 40 ) \ 44 d = l + 28 - 31 * ( m \ 4 ) dateEaster = Dateserial(y, m, d) End Function
Do you have comments on this tip? Let us know.
This tip was submitted to the SearchDomino.com tip exchange by member Cesar Mugnatto. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.