VBA Holiday Generate & Check

_vba_util_holiday.readme

----------------------------------
VBA Holiday Creation & Determination
----------------------------------

Various Holiday Func's that determine what date a holiday
is on based on the year you pass them. EG: Pass the Memorial
Day function the year 2025, and it will figure out when Memorial
Day is in 2025.

HolidayCheck func leverages these "when's the holiday date?"
func's by passing in a date, and it using the year of the
date to see if the date is a holiday or not.

Purpose ...

Had a coding challenge for a job interview
that wanted me to take a year's worth of data
in excel and use it as base model for other
years. This required matching up days to
days (eg: first monday of year in sample data
to first monday of newly generated year),
and also modelling out holidays as override
data.

The hackish solution would be to create a lookup
table / spreadsheet for the holiday dates to take
into consideration. But, that would need manual
intervention, and would be limited based on how
far in the future you had the holiday dates go.
EG: if you only scoped dates through 2035, then
you couldn't model past 2035.

I'm not hackish, so I first had to code up some
functions to figure out which days were holidays
in any year I modelled out. This way, the code
would be self-sufficient, being able to model
ANY year without manual intervention.

Plus, a "holiday" code lib can be re-used for
other calendar-oriented projects. Double-win.

Online, I found folks had ideas on how to do
it in other langs, but didn't see any
VBA-specific code. So, I took some theories
and coded them in VBA.

Fixed holidays are easy (eg: Jan 1st will
always be New Years), but Floating holidays
needed more thought, (eg: you have to figure
out which date the 4th thurs in November
thanksgiving will fall on).

Also, while you can do some hack methods
like loops through a month (eg: start on
1st of Nov and loop until you find 4th
thurs for thanksgiving) part of coding is
to find an elegant solution. One that is
simple both in what it does and easy to
understand. So, I took the time to do that
instead of hack methods.

I left the "Day Test" func's, so
folks could see the logic I worked through
to come up with the end-result functions.

vba_util_holiday.bas

'---------------------------------------
' misc holiday routines
'---------------------------------------

Option Explicit

'---------------------------------------
' MEMORIAL DAY
'---------------------------------------
' ... is last monday of May.
' So, start on May 31st, and figure out
' weekday # for that using vbMonday as
' start of week.. then 5/31 - wkday + 1
' to figure out last monday.
'---------------------------------------

Public Function MemorialDayDate(Yr As Integer) As Date

    MemorialDayDate = DateSerial(Yr, 5, 31)     ' get May 31st
    MemorialDayDate = MemorialDayDate - Weekday(MemorialDayDate, vbMonday) + 1

End Function

'-------------------------------
' LABOR DAY
'-------------------------------
' ... is first monday of Sep.
' if we take May 1st, and check weekday
' of it using tues as start of week,
' we can add ( 7 - wkday value )
' to may 1st to get first monday
'--------------------------------------

Public Function LaborDayDate(Yr As Integer) As Date

    LaborDayDate = DateSerial(Yr, 9, 1)         ' get Sept 1st
    LaborDayDate = LaborDayDate + 7 - Weekday(LaborDayDate, vbTuesday)

End Function

'---------------------------------------
' THANKSGIVING
'---------------------------------------
' ... is 4th Thurs of Nov.
' So, start on Nov 1st, use Friday as
' first day of week to determine 11/1's
' weekday value, then add ( 7 - it )
' to 11/1 to get first thurs. Then just
' add 3 weeks to that to get 4th thurs.
'---------------------------------------

Public Function ThanksgivingDate(Yr As Integer) As Date

    ThanksgivingDate = DateSerial(Yr, 11, 1)    ' get Nov 1st

'    ThanksgivingDate = ThanksgivingDate + 7 - Weekday(ThanksgivingDate, vbFriday)
'    ThanksgivingDate = ThanksgivingDate + 21

    ' just occurred to me we can just add 4 wks from
    ' the start (7 + 21) then subtract the weekday val
    ' duh
    ThanksgivingDate = ThanksgivingDate + 28 - Weekday(ThanksgivingDate, vbFriday)

End Function


'-----------------------------------------
' test / debug
'-----------------------------------------
' I left the Memorial Day & Labor Day
' test func's below, b/c they show
' the logic I went through to figure out
' how to code them as floating holiday's in
' VBA (the func's above use that logic).
' This can help you understand the code,
' in case you need to add a new floating
' holiday.
'-----------------------------------------

Sub FloatingHolidayTest()
' test the floating holiday functions
' to see what dates they're pulling back
' for years provided

    If True Then
        Debug.Print "Memorial Day"
        Debug.Print MemorialDayDate(2019)
        Debug.Print MemorialDayDate(2020)
        Debug.Print MemorialDayDate(2021)
    End If

    If True Then
        Debug.Print "Labor Day"
        Debug.Print LaborDayDate(2019)
        Debug.Print LaborDayDate(2020)
        Debug.Print LaborDayDate(2021)
    End If
    
    If True Then
        Debug.Print "Thanksgiving"
        Debug.Print ThanksgivingDate(2019)
        Debug.Print ThanksgivingDate(2020)
        Debug.Print ThanksgivingDate(2021)
    End If

End Sub

'-----------------------------------------

Sub LaborDayTest()
' testing a more elegant method to get 1st mon of Sep
' instead of just iterating like an idiot
'
' labor day is on first mon of may
' if we take May 1st, and check weekday
' of it using tues as start of week,
' we can add ( 7 - wkday value )
' to may 1st to get first monday
'
' vbSunday as start of week
' 1   Sunday
' 2   Monday
' 3   Tuesday
' 4   Wednesday
' 5   Thursday
' 6   Friday
' 7   Saturday
'
' vbTuesday as start of week
' 6   Sunday
' 7   Monday
' 1   Tuesday
' 2   Wednesday
' 3   Thursday
' 4   Friday
' 5   Saturday
'
' EG:
'
' 9/1/19 = Sunday
' weekday(9/1/19, vbTuesday) = 6
' 9/1/19 + ( 7 - 6 ) = 9/1/19 + 1 = 9/2/19 as first monday
'
' 9/1/20 = Tuesday
' weekday(9/1/20, vbTuesday) = 1
' 9/1/20 + ( 7 - 1 ) = 9/1/20 + 6 = 9/7/20 as first monday

    Dim d As Date

    d = #9/1/2019#
    Debug.Print Weekday(d, vbTuesday)
    Debug.Print d + 7 - Weekday(d, vbTuesday)

    d = #9/1/2020#
    Debug.Print Weekday(d, vbTuesday)
    Debug.Print d + 7 - Weekday(d, vbTuesday)

    d = #9/1/2021#
    Debug.Print Weekday(d, vbTuesday)
    Debug.Print d + 7 - Weekday(d, vbTuesday)

End Sub

'-----------------------------------------

Sub MemorialDayTest()
' testing a more elegant method to get last mon of May
'
' for labor day, we got 9/1's weekday,
' using the day-after-our-target (tuesday)
' as the start-of-week. So, why can't we
' do the same for 5/31.. and subtract
' into the last monday?
'
' vbMonday as start of week
' 7   Sunday
' 1   Monday
' 2   Tuesday
' 3   Wednesday
' 4   Thursday
' 5   Friday
' 6   Saturday
'
' EG:
'
' 5/31/19 = Friday
' weekday(5/31/19, vbTuesday) = 4
' 5/31/19 - 4 = 5/27/19 as last monday
'
' 5/31/20 = Sunday
' weekday(5/31/20, vbTuesday) = 6
' 5/31/20 - 6 = 5/25/20 as first monday


'Memorial Day
'5/27/2019
'5/25/2020
'5/31/2021

    Dim d As Date
' + 1 offsets Monday as 1
' so if 5/31 is a monday, then 5/31 - 1 + 1 .. zeroes out the math
    
    d = #5/31/2019#
    Debug.Print Weekday(d, vbMonday)
    Debug.Print d - Weekday(d, vbMonday) + 1

    d = #5/31/2020#
    Debug.Print Weekday(d, vbMonday)
    Debug.Print d - Weekday(d, vbMonday) + 1

    d = #5/31/2021#
    Debug.Print Weekday(d, vbMonday)
    Debug.Print d - Weekday(d, vbMonday) + 1

End Sub

vba_util_holiday_check.bas

'----------------------------
' Holiday Check
'----------------------------
' checks if date provided is one
' of the 6 holidays tracked.
' Returns string val of holiday found.
' Returns "" if nothing found.
'----------------------------
'
' Holidays isolated and rules for them
' (using 2020 as example year)
'
' DATE        HOLIDAY       RULE
' 01/01/20    new years     always 1st of year
' 05/25/20    memorial day  last mon of may
' 07/04/20    july 4th      always 4th of jul
' 09/07/20    labor day     1st mon of sep
' 11/26/20    thanksgiving  4th thurs in Nov
' 12/25/20    christmas     always 25th of dec
'
'-----------------------------------

Option Explicit

'-----------------------------------

Public Function HolidayCheck(dateToCheck As Date) As String

    Dim mmdd As String        ' month_day string for fixed holidays
    Dim yyyy As Integer       ' year for floating holidays
    
    mmdd = DatePart("m", dateToCheck) & "_" _
         & DatePart("d", dateToCheck)
    yyyy = DatePart("yyyy", dateToCheck)


    ' test for fixed holidays that happen
    ' on specific month / day combo

    If mmdd = "1_1" Then          ' New Years .. always on Jan 1st
        HolidayCheck = "New Years"
    ElseIf mmdd = "7_4" Then      ' July 4th  .. always on Jul 4th
        HolidayCheck = "July 4th"
    ElseIf mmdd = "12_25" Then    ' Christmas .. always on Dec 25th
        HolidayCheck = "Christmas"
   
    
    ' test for float holidays that happen
    ' on certain weekdays in months

  ElseIf dateToCheck = MemorialDayDate(yyyy) Then     ' Meorial Day ... always last mon of May
        HolidayCheck = "Memorial Day"
  ElseIf dateToCheck = LaborDayDate(yyyy) Then        ' Labor Day ... always first mon of Sep
        HolidayCheck = "Labor Day"
  ElseIf dateToCheck = ThanksgivingDate(yyyy) Then    ' Thanksgiving ... always last thurs of Nov
        HolidayCheck = "Thanksgiving"
  End If

End Function


'--------------------------
' testing / debug
'--------------------------

Sub HolidayCheckTestDate()
' test specific date
    
    Dim d1 As Date
    Dim d2 As Date

    d1 = #5/27/2019#    ' memorial day 2019
    d2 = MemorialDayDate(DatePart("yyyy", d1))

    Debug.Print d1
    Debug.Print d2

End Sub

'--------------------------

Sub HolidayCheckTestYear()
' roll out whole year to "data_output"
' sheet to double-check holidays flagged

    Dim d As Date
    Dim i As Integer
    Dim r As Range
    
    Set r = Sheets("data_output").Range("A1")
    
    d = #1/1/2019#

    For i = 0 To 365
        With r
            .Offset(i, 0).Value = d
            .Offset(i, 1).Value = HolidayCheck(d)
        End With
        d = d + 1
    Next

End Sub