Public Enum HolidayName
holNew_Years = 1
holML_King_BDay = 2
holPresidents_Day = 3
holEaster = 4
holMemorial_Day = 5
holIndependance_Day = 6
holLabor_Day = 7
holColumbus_Day = 8
holVeterans_Day = 9
holThanksgiving = 10
holChristmas = 11
End Enum
Public Function GetHoliday(ByVal TheYear As Long, TheHolidayName As HolidayName) As Date
Dim intWeekDay As Integer
Dim intDay As Integer
Dim intMonth As Integer
'New Years Day
Select Case TheHolidayName
Case holNew_Years
GetHoliday = DateSerial(TheYear, 1, 1)
Case holML_King_BDay
'3rd monday of January
GetHoliday = DayOfNthWeek(TheYear, 1, 3, vbMonday)
Case holPresidents_Day
'Presidents Day 3rd Monday of Feb
GetHoliday = DayOfNthWeek(TheYear, 2, 3, vbMonday)
Case holMemorial_Day
GetHoliday = LastMondayInMonth(TheYear, 5)
Case holIndependance_Day
GetHoliday = DateSerial(TheYear, 7, 4)
Case holLabor_Day
GetHoliday = DayOfNthWeek(TheYear, 9, 1, vbMonday)
Case holColumbus_Day
GetHoliday = DayOfNthWeek(TheYear, 10, 2, vbMonday)
Case holVeterans_Day
' Veteranss Day
' Although originally scheduled for celebration on November 11,
' starting in 1971 Veterans Day was moved to the fourth Monday of October.
' In 1978 it was moved back to its original celebration on November 11.
GetHoliday = DateSerial(TheYear, 11, 11)
Case holThanksgiving
GetHoliday = DayOfNthWeek(TheYear, 11, 4, vbThursday)
Case holChristmas
GetHoliday = DateSerial(TheYear, 12, 25)
Case holEaster
'Not US Federal Holiday
GetHoliday = EasterUSNO(TheYear)
End Select
End Function
Public Function DayOfNthWeek(intYear As Long, intMonth As Integer, N As Integer, vbDayOfWeek As Integer) As Date
'Thanksgiving is the 4th thursday in November(11)
'dayOfNthWeek(theYear,11,4,vbThursday)
DayOfNthWeek = DateSerial(intYear, intMonth, (8 - Weekday(DateSerial(intYear, intMonth, 1), _
(vbDayOfWeek + 1) Mod 8)) + ((N - 1) * 7))
End Function
Function LastMondayInMonth(intYear As Long, intMonth As Long) As Date
'Used for memorial day
Dim LastDay As Date
'define last day of the month of interest:
LastDay = DateSerial(intYear, intMonth + 1, 0)
'use to get last monday:
LastMondayInMonth = LastDay - Weekday(LastDay, vbMonday) + 1
End Function
Public Function EasterUSNO(YYYY As Long) As Long
Dim C As Long
Dim N As Long
Dim K As Long
Dim I As Long
Dim J As Long
Dim L As Long
Dim M As Long
Dim D As Long
C = YYYY \ 100
N = YYYY - 19 * (YYYY \ 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 = YYYY + YYYY \ 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)
EasterUSNO = DateSerial(YYYY, M, D)
End Function