magritton
12/12/2017 - 4:20 PM
VB Red Letter Day Function
This function checks a date to see if it is a holiday or a curtailment day, i.e. Christmas break
Function Red_Letter_Day(Testing_Date As Date, Optional Exclude_Curtailment As Boolean) As Boolean
Dim Return_Value As Boolean
Dim temp_date_str As String
Dim Holiday_Date As Date
Dim TestMonth As Long
TestMonth = Month(Testing_Date)
Return_Value = False
Select Case TestMonth
Case 1 'JANUARY
'New Year's Day
temp_date_str = "1/1/" & Year(Testing_Date)
Select Case Weekday(DateValue(temp_date_str))
Case 1
Holiday_Date = DateValue(temp_date_str) + 1
Case 2, 3, 4, 5, 6
Holiday_Date = DateValue(temp_date_str)
End Select
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
'MLK Jr. Day: 3rd Monday of January
temp_date_str = "1/1/" & Year(Testing_Date)
Holiday_Date = DateValue("1/" & Choose(Weekday(DateValue(temp_date_str)), 16, 15, 21, 20, 19, 18, 17) & "/" & Year(DateValue
(temp_date_str))) '1st Monday in September
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
If Not Exclude_Curtailment Then
'January 1st is always
If Day(Testing_Date) = 1 Then
Return_Value = True: GoTo Found_Holiday
End If
'January 2nd is Holiday only if it falls on Fri, Sat, Sun, Mon
temp_date_str = "1/2/" & Year(Testing_Date)
Select Case Weekday(DateValue(temp_date_str))
Case 6, 7, 1, 2 'If the 2nd is on Fri, Sat, Sun, Mon
Holiday_Date = DateValue(temp_date_str)
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case Else
End Select
'January 3rd only holiday on Weekend
temp_date_str = "1/3/" & Year(Testing_Date)
Select Case Weekday(DateValue(temp_date_str))
Case 7, 1
Holiday_Date = DateValue(temp_date_str)
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case Else
End Select
'January 4th only holiday on Sunday
temp_date_str = "1/4/" & Year(Testing_Date)
Select Case Weekday(DateValue(temp_date_str))
Case 1
Holiday_Date = DateValue(temp_date_str)
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case Else
End Select
End If
Case 2 'FEBRUARY
'Washington's Birthday: 3rd Monday of February
temp_date_str = "2/1/" & Year(Testing_Date)
Holiday_Date = DateValue("2/" & Choose(Weekday(DateValue(temp_date_str)), 16, 15, 21, 20, 19, 18, 17) & "/" & Year(DateValue
(temp_date_str))) '1st Monday in September
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case 3 'MARCH
Case 4 'APRIL
Case 5 'MAY
'Memorial Day: Last Monday in May
temp_date_str = "5/1/" & Year(Testing_Date)
Holiday_Date = DateValue("5/" & Choose(Weekday(DateValue(temp_date_str)), 30, 29, 28, 27, 26, 25, 31) & "/" & Year(DateValue
(temp_date_str))) '1st Monday in September
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case 6 'JUNE
Case 7 'JULY
'Independence Day
temp_date_str = "7/4/" & Year(Testing_Date)
If Weekday(DateValue(temp_date_str)) = 7 Then
Holiday_Date = DateValue(temp_date_str) - 1
ElseIf Weekday(DateValue(temp_date_str)) = 1 Then
Holiday_Date = DateValue(temp_date_str) + 1
Else
Holiday_Date = DateValue(temp_date_str)
End If
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case 8 'AUGUST
Case 9 'SEPTEMBER
'Labor Day: 1st Monday in September
temp_date_str = "9/1/" & Year(Testing_Date)
Holiday_Date = DateValue("9/" & Choose(Weekday(DateValue(temp_date_str)), 2, 1, 7, 6, 5, 4, 3) & "/" & Year(DateValue(temp_date_str))) '1st
Monday in September
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case 10 'OCTOBER
'Columbus Day: 2nd Monday in October
temp_date_str = "10/1/" & Year(Testing_Date)
Holiday_Date = DateValue("10/" & Choose(Weekday(DateValue(temp_date_str)), 9, 8, 14, 13, 12, 11, 10) & "/" & Year(DateValue(temp_date_str)))
'1st Monday in September
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case 11 'NOVEMBER
'Veteran's Day: 11/11 every year but goes to Monday if it lands on a Sunday and goes to a Friday if lands on a Saturday
temp_date_str = "11/11/" & Year(Testing_Date)
If Weekday(DateValue(temp_date_str)) = 7 Then
Holiday_Date = DateValue(temp_date_str) - 1
ElseIf Weekday(DateValue(temp_date_str)) = 1 Then
Holiday_Date = DateValue(temp_date_str) + 1
Else
Holiday_Date = DateValue(temp_date_str)
End If
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
'Thanksgiving: 4th Thursday in November
'Memorial Day: Last Monday in May
temp_date_str = "11/1/" & Year(Testing_Date)
Holiday_Date = DateValue("11/" & Choose(Weekday(DateValue(temp_date_str)), 26, 25, 24, 23, 22, 28, 27) & "/" & Year(DateValue
(temp_date_str))) '1st Monday in September
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case 12 'DECEMBER
'If the Testing_Date is 12/31 for a current year and it falls on a Friday, then we know that it is a holiday
temp_date_str = "12/31/" & Year(Testing_Date)
Select Case Weekday(DateValue(temp_date_str))
Case 6
Holiday_Date = DateValue(temp_date_str)
End Select
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
'Holiday Shutdown Starts December 25th
temp_date_str = "12/25/" & Year(Testing_Date)
If Weekday(DateValue(temp_date_str)) = 7 Then
Holiday_Date = DateValue(temp_date_str) - 1
ElseIf Weekday(DateValue(temp_date_str)) = 1 Then
Holiday_Date = DateValue(temp_date_str) + 1
Else
Holiday_Date = DateValue(temp_date_str)
End If
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
If Not Exclude_Curtailment Then
'Holiday Shutdown Dates
'There is a discrepancy when Christmas (Decemeber 25th) falls on A Wednesday or a Friday. Sometimes the 24th is taken off, sometimes not
'For the purposes here it is assumed that it is NOT taken off.
'If Christmas Falls on Thursday, the 1st then falls on a Thursday and the 2nd of the next year is taken off instead of Christmas eve
'Holiday Shutdown Starts December 25th
'December 24th
temp_date_str = "12/24/" & Year(Testing_Date)
Select Case Weekday(DateValue(temp_date_str))
Case 1, 2, 6, 7 'If the 24th is on Sun, Mon, Sat, or Sun
Holiday_Date = DateValue(temp_date_str)
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case Else
End Select
'December 23rd only holiday on Weekend
temp_date_str = "12/23/" & Year(Testing_Date)
Select Case Weekday(temp_date_str)
Case 1, 7
Holiday_Date = DateValue(temp_date_str)
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case Else
End Select
'December 22nd only holiday on Saturday
temp_date_str = "12/22/" & Year(Testing_Date)
Select Case Weekday(temp_date_str)
Case 7
Holiday_Date = DateValue(temp_date_str)
If Testing_Date = Holiday_Date Then Return_Value = True: GoTo Found_Holiday
Case Else
End Select
'Between Christmas and New Years
Select Case Day(Testing_Date)
Case 25, 26, 27, 28, 29, 30, 31
Return_Value = True: GoTo Found_Holiday
Case Else
End Select
End If
End Select
Found_Holiday:
Red_Letter_Day = Return_Value
End Function