Using TDD to Calculate Holidays in VBA
In a recent article, I took a brute-force approach to identifying US federal holidays. The approach consisted of grabbing a listing of published holidays from the OPM website and using that to return a collection of federal holidays between two dates.
One of the major disadvantages of the approach is that it is limited in terms of the number of years covered. Based on current and past OPM date publications, the function returns a collection of holidays for the years 1997 - 2030 only.
On the plus side, this brute force approach presents a great opportunity to write a new function using a Test Driven Design (TDD) approach.
Test Driven Design
The TDD approach to software development requires that you begin not by writing code, but by writing tests. Here are the basic steps:
- Write tests that will only pass with properly written code
- Run the tests to ensure they fail
- Write the code until the tests pass
One criticism of TDD is that you are just as likely to make a mistake writing a test as you are writing the code. This is true, but it doesn't really matter. The important point is that you are less likely to make the same mistake in two different ways than you are to make a single mistake once.
Whether the mistake is in your code or in your test is ultimately meaningless. You'll fix one or the other until the test passes.
A big advantage of this approach is that you can refactor routines with the confidence that you won't accidentally break anything, provided they have effective test coverage.
TDD in VBA
Unlike more modern programming languages, there are very few options in terms of robust testing frameworks in VBA. The best one that I am aware of is the Rubberduck project. However, I find the add-in too heavyweight for most of my Access applications, as it does take quite a bit of time to parse a VBA project with dozens of code modules.
For very simple testing, I borrowed the doc test concept from Python. This works best for testing public functions in standard code modules. It's got a nice, clean interface for that purpose, but it has no support for mocking objects and very little support for testing class modules at all.
When I've needed to do more extensive testing, I've taken the approach of rolling my own tests. This is nowhere near as effective as running an automated suite of tests, but it's an improvement over no testing at all. One big advantage to cobbling together your own testing framework is that it helps you better understand why test frameworks like xUnit and JUnit work the way they do in other languages.
Step 1. Building our test
We have an existing function named FedHolidays() which returns a collection of holidays between any two dates, so long as they fall between the years 1997 and 2030. Let's create a new function named FederalHolidays() which will return the same collection of dates. However, instead of relying on the brute force approach, it will calculate each holiday based on the current legal formulae.
Before we write the function, let's begin by writing the test we will use to prove its correctness. This assumes that our existing function, FedHolidays(), has no errors. Of course, we should bear in mind that if the test does fail, it's equally likely to be an error with the original function as it is with the new function.
There are two parts to the test function:
- First, we test the total count in each collection
- Then, we verify that each entry in the two collections is identical
Here's the code. Note that it makes use of my Throw function.
Sub TestFedHolidays()
Const EarliestDate As Date = #1/1/1997#
Const LatestDate As Date = #12/31/2030#
Dim FedOld As Collection
Dim FedNew As Collection
Set FedOld = FedHolidays(EarliestDate, LatestDate)
Set FedNew = FederalHolidays(EarliestDate, LatestDate)
'First, test the counts
If FedNew.Count <> FedOld.Count Then
Throw "Holiday count mismatch. Old: {0}; New: {1}", _
FedOld.Count, FedNew.Count
End If
'Then, test each individual entry in the collections
Dim i As Long
For i = 1 To FedOld.Count
If FedOld(i) <> FedNew(i) Then
Throw "Expected: {0}; Actual: {1}", _
FedOld(i), FedNew(i)
End If
Next i
Debug.Print FedOld.Count; " tests passed"
End SubStep 2. Run the failing tests
Before we can run the failing test, we need to make sure the code at least compiles. To do that, we write a skeleton function for the new FederalHolidays() function that returns an initialized collection.
'Returns a collection of calculated dates that represent federal holidays
Function FederalHolidays(Optional StartDate, Optional EndDate) As Collection
Set FederalHolidays = New Collection
End FunctionIf we run the TestFedHolidays() function now we get the following results:
Holiday count mismatch. Old: '350'; New: '0'
Step 3. Write code until the tests pass
First, we'll write just enough code until the first part of our test passes: the count check:
'Returns a collection of calculated dates that represent federal holidays
Function FederalHolidays(Optional StartDate, Optional EndDate) As Collection
Set FederalHolidays = New Collection
Dim StartYear As Integer: StartYear = Year(StartDate)
Dim EndYear As Integer: EndYear = Year(EndDate)
Dim Yr As Integer
For Yr = StartYear To EndYear
Dim i As Integer
For i = 1 To 10
FederalHolidays.Add DateSerial(Yr, i, 1)
Next i
Next Yr
End FunctionNote that the code above simply returns the first day of each month for the first ten months of each year as the federal holidays for those years. This results in the correct overall count and it even matches the very first holiday, which happens to be New Year's Day 1997. But Martin Luther King, Jr. Day is incorrect.
When I run the test code, I get a new error now:
Expected: '1/20/1997'; Actual: '2/1/1997'
Now that we've cleared the first hurdle, we can write code to pass the second hurdle: matching the actual dates.
Calculating the holiday dates
The approach I'm using is to calculate each holiday date independently within a given year. To do this, I'm updating the For loop in my code. I'm using the Pseudocode Programming Practice to start filling in some of the blanks of my For loop. You see, some holidays are tied to a specific date, like New Year's Day or Christmas Day. Other holidays fall on the 1st/2nd/3rd/4th/Last day of one month or another, like Memorial Day or Labor Day.
For i = 1 To 11
Dim Dt As Date
Select Case i
Case 1 'New Year's Day
Dt = DateSerial(Yr, 1, 1)
Case 2 'Birthday of Martin Luther King, Jr.
'3rd Monday of January
Case 3 'Washington's Birthday
'3rd Monday of February
Case 4 'Memorial Day
'Last Monday of May
Case 5 'Juneteenth
Dt = DateSerial(Yr, 6, 19)
Case 6 'Independence Day
Dt = DateSerial(Yr, 7, 4)
Case 7 'Labor Day
'1st Monday of September
Case 8 'Columbus Day
'2nd Monday of October
Case 9 'Veterans Day
Dt = DateSerial(Yr, 11, 11)
Case 10 'Thanksgiving Day
'4th Thursday of November
Case 11 'Christmas Day
Dt = DateSerial(Yr, 12, 25)
End Select
FederalHolidays.Add Dt
Next iHow exactly are we going to calculate the n-th weekday of a given month? I'm not sure yet, but that seems like a great candidate for breaking out a standalone function.
We'll use TDD and doc tests to build the OrdinalWeekdayOfMonth() function. Let's start by returning the actual holiday dates for all the holidays in 2020 that are based off of the n-th weekday of a month:
'Returns the Nth weekday of a given month and year
' - Pass a 5 for Nth to get the last instance of that weekday in the given month
'>>> OrdinalWeekdayOfMonth(3, 2, 1, 2020)
' 1/20/2020
'>>> OrdinalWeekdayOfMonth(3, 2, 2, 2020)
' 2/17/2020
'>>> OrdinalWeekdayOfMonth(5, 2, 5, 2020)
' 5/25/2020
'>>> OrdinalWeekdayOfMonth(1, 2, 9, 2020)
' 9/7/2020
'>>> OrdinalWeekdayOfMonth(2, 2, 10, 2020)
' 10/12/2020
'>>> OrdinalWeekdayOfMonth(4, 5, 11, 2020)
' 11/26/2020
Function OrdinalWeekdayOfMonth(Nth As Byte, DayOfWeek As VbDayOfWeek, Mo As Byte, Yr As Integer)
End FunctionOf course, the function doesn't return anything at all yet, so we know the tests will all fail. Now we can start filling in the function with some code until the tests all pass. The following code should do it:
'Returns the Nth weekday of a given month and year
' - Pass a 5 for Nth to get the last instance of that weekday in the given month
'>>> OrdinalWeekdayOfMonth(3, 2, 1, 2020)
' 1/20/2020
'>>> OrdinalWeekdayOfMonth(3, 2, 2, 2020)
' 2/17/2020
'>>> OrdinalWeekdayOfMonth(5, 2, 5, 2020)
' 5/25/2020
'>>> OrdinalWeekdayOfMonth(1, 2, 9, 2020)
' 9/7/2020
'>>> OrdinalWeekdayOfMonth(2, 2, 10, 2020)
' 10/12/2020
'>>> OrdinalWeekdayOfMonth(4, 5, 11, 2020)
' 11/26/2020
Function OrdinalWeekdayOfMonth(Nth As Byte, DayOfWeek As VbDayOfWeek, Mo As Byte, Yr As Integer)
If Nth < 1 Or Nth > 5 Then Throw "Invalid Nth value: {0} (should be 1 - 5)", Nth
If Mo < 1 Or Mo > 12 Then Throw "Invalid Month value: {0} (should be 1 - 12)", Mo
If Yr < 100 Or Yr > 9999 Then Throw "Invalid Year value: {0} (should be 100 - 9999)", Yr
Dim i As Integer, TempDate As Date
For i = 0 To 6
If Nth = 5 Then 'Last weekday of the month
TempDate = MonthEnd(DateSerial(Yr, Mo, 1)) - i
Else 'Nth weekday of the month
TempDate = DateSerial(Yr, Mo, (7 * (Nth - 1) + 1)) + i
End If
If Weekday(TempDate) = DayOfWeek Then
OrdinalWeekdayOfMonth = TempDate
Exit Function
End If
Next i
End FunctionUpdating the holiday date calculation
If we incorporate the OrdinalWeekdayOfMonth() function into our code, we can continue closing in on a solution:
For i = 1 To 11
Dim Dt As Date
Select Case i
Case 1 'New Year's Day
Dt = DateSerial(Yr, 1, 1)
Case 2 'Birthday of Martin Luther King, Jr.
'3rd Monday of January
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 1, Yr)
Case 3 'Washington's Birthday
'3rd Monday of February
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 2, Yr)
Case 4 'Memorial Day
'Last Monday of May
Dt = OrdinalWeekdayOfMonth(5, vbMonday, 5, Yr)
Case 5 'Juneteenth
Dt = DateSerial(Yr, 6, 19)
Case 6 'Independence Day
Dt = DateSerial(Yr, 7, 4)
Case 7 'Labor Day
'1st Monday of September
Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
Case 8 'Columbus Day
'2nd Monday of October
Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
Case 9 'Veterans Day
Dt = DateSerial(Yr, 11, 11)
Case 10 'Thanksgiving Day
'4th Thursday of November
Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
Case 11 'Christmas Day
Dt = DateSerial(Yr, 12, 25)
End SelectNow when we run our test function, we get the following error:
Expected: '7/3/1998'; Actual: '7/4/1998'
In other words, all of the holidays for 1997 match up now. The last thing we need to fix are those dated holidays where the actual date falls on a Saturday or Sunday. We have four instances of those types of holidays. In each case, if the holiday falls on a Saturday, it is observed on the prior Friday, and if the holiday falls on a Sunday, it is observed on the following Monday.
Let's make a quick function to return this date:
'Returns the observance of a federal holiday by adjusting for
' dated holidays that fall on a weekend
' - If the holiday falls on a Saturday, return the prior Friday
' - If the holiday falls on a Sunday, return the following Monday
' - If the holiday falls on a weekday, return the same date
'>>> GetHolidayObservanceDate(#7/4/1997#)
' 7/4/1997
'>>> GetHolidayObservanceDate(#7/4/1998#)
' 7/3/1998
'>>> GetHolidayObservanceDate(#7/4/1999#)
' 7/5/1999
Function GetHolidayObservanceDate(DateOfActualHoliday As Date) As Date
Select Case Weekday(DateOfActualHoliday)
Case vbSaturday
GetHolidayObservanceDate = DateOfActualHoliday - 1
Case vbSunday
GetHolidayObservanceDate = DateOfActualHoliday + 1
Case Else
GetHolidayObservanceDate = DateOfActualHoliday
End Select
End FunctionWhen we incorporate this function into our FederalHolidays() Select..Case statement, (almost) everything works:
Select Case i
Case 1 'New Year's Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 1, 1))
Case 2 'Birthday of Martin Luther King, Jr.
'3rd Monday of January
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 1, Yr)
Case 3 'Washington's Birthday
'3rd Monday of February
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 2, Yr)
Case 4 'Memorial Day
'Last Monday of May
Dt = OrdinalWeekdayOfMonth(5, vbMonday, 5, Yr)
Case 5 'Juneteenth
Dt = GetHolidayObservanceDate(DateSerial(Yr, 6, 19))
Case 6 'Independence Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 7, 4))
Case 7 'Labor Day
'1st Monday of September
Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
Case 8 'Columbus Day
'2nd Monday of October
Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
Case 9 'Veterans Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 11, 11))
Case 10 'Thanksgiving Day
'4th Thursday of November
Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
Case 11 'Christmas Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 12, 25))
End SelectIf I run TestFedHolidays() now, I get the following result:
Holiday count mismatch. Old: '350'; New: '374'
What's the source of the mismatch? Why does the new function return so many extra holidays?
Juneteenth: A New Federal Holiday
In 2021, President Biden signed into law the Juneteenth National Independence Day Act, establishing June 19 as a federal holiday to celebrate the end of slavery in the United States. What this means is that the holiday was not a federal holiday in 2020 and earlier. We need some way to account for that.
To do that, I added a check on the year when adding the Juneteenth holiday. If the year within the loop is less than 2021, then we skip the rest of the For Loop iteration. Since VBA does not have a Continue For or equivalent statement, I use a line label and Goto statement to provide the same functionality.
For i = 1 To 11
Dim Dt As Date
Select Case i
Case 1 'New Year's Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 1, 1))
Case 2 'Birthday of Martin Luther King, Jr.
'3rd Monday of January
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 1, Yr)
Case 3 'Washington's Birthday
'3rd Monday of February
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 2, Yr)
Case 4 'Memorial Day
'Last Monday of May
Dt = OrdinalWeekdayOfMonth(5, vbMonday, 5, Yr)
Case 5 'Juneteenth National Independence Day
'Juneteenth was first celebrated as a federal holiday in 2021
If Yr < 2021 Then GoTo NextHoliday
Dt = GetHolidayObservanceDate(DateSerial(Yr, 6, 19))
Case 6 'Independence Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 7, 4))
Case 7 'Labor Day
'1st Monday of September
Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
Case 8 'Columbus Day
'2nd Monday of October
Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
Case 9 'Veterans Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 11, 11))
Case 10 'Thanksgiving Day
'4th Thursday of November
Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
Case 11 'Christmas Day
Dt = GetHolidayObservanceDate(DateSerial(Yr, 12, 25))
End Select
FederalHolidays.Add Dt
NextHoliday:
Next iMissing tests
At this point, we might declare ourselves finished. Here is where overreliance on TDD can get you into trouble. If you look closely, you will see that our original FedHolidays() function returned a collection between two dates.
You might be tempted to think that our TestFedHolidays() function provides 100% test coverage because it checks to make sure that every single date returned by the original FedHolidays() function can be faithfully reproduced by the new FederalHolidays() function.
However, I'm missing one critical situation. What happens if the date range passed to FederalHolidays() does not cover a complete calendar year? What if, instead, we request only the holidays from the second and third quarter of 2020?
Let's refactor the original tests function into two separate functions. We'll create a new public routine to run the tests with a variety of start and end dates. We'll modify the existing routine, make it private, and set it to accept an arbitrary pair of start and end dates.
Sub TestFedHolidays()
TestFedHolidaysRunner #1/1/1997#, #12/31/2030#
TestFedHolidaysRunner #4/1/2020#, #9/30/2020#
End Sub
Private Sub TestFedHolidaysRunner(StartDate As Date, EndDate As Date)
Dim FedOld As Collection
Dim FedNew As Collection
Set FedOld = FedHolidays(StartDate, EndDate)
Set FedNew = FederalHolidays(StartDate, EndDate)
'First, test the counts
If FedNew.Count <> FedOld.Count Then
Throw "Holiday count mismatch. Old: {0}; New: {1}", _
FedOld.Count, FedNew.Count
End If
'Then, test each individual entry in the collections
Dim i As Long
For i = 1 To FedOld.Count
If FedOld(i) <> FedNew(i) Then
Throw "Expected: {0}; Actual: {1}", _
FedOld(i), FedNew(i)
End If
Next i
Debug.Print FedOld.Count; " tests passed"
End SubNow, when we run the TestFedHolidays() function, we receive the following error:
Holiday count mismatch. Old: '3'; New: '10'
Reproducing bugs with tests
When you find a bug during TDD, the first thing you should do is create a test to reproduce the bug. That way, the same bug can't creep back into your code at some point in the future.
Having reproduced the bug above and generated a failing test, it is now time to fix the bug. When we're adding dates to our holiday collection in our new FederalHolidays() function, we need to make sure that the dates we're trying to add fall within the range of our StartDate and EndDate.
I fixed the bug by changing the following line from this...
FederalHolidays.Add Dt ...to this...
If Dt >= StartDate And Dt <= EndDate Then
FederalHolidays.Add Dt
End IfNow, if I rerun the TestFedHolidays() function, I get this result:
350 tests passed
3 tests passedYear Checks for All Holidays
As I was adding the year check for Juneteenth, it occurred to me that I should also add year checks for all the rest of the holidays. The final code for the FederalHolidays function shown at the bottom of the article includes year checks for all eleven federal holidays. Additionally, there are some holidays whose official date of observance has changed over the years. I added year checks for those, too.
If you see any problems, drop a note in the comments below and I will update the code.
Recap
TDD–and software development in general–is an iterative process. The TDD approach is a safe way to break down a complex problem into a series of smaller tasks, with each step of the process guided and verified by automated tests.
Most importantly, you don't need a fancy testing framework to put the concepts of TDD to good use. In fact, starting without such a framework is a great way to get started. It forces you to understand the underlying concepts that frameworks often abstract away for you. It's also generally easier to troubleshoot your own code than to try to figure out how to implement a complex testing framework.
The Code
Below is a recap of all the code we introduced in today's lengthy article.
To get the code to compile, you'll need some other functions I've written about in the past, including Throw(), MonthEnd(), and FedHolidays().
Sub TestFedHolidays()
TestFedHolidaysRunner #1/1/1997#, #12/31/2030#
TestFedHolidaysRunner #4/1/2020#, #9/30/2020#
End Sub
Private Sub TestFedHolidaysRunner(StartDate As Date, EndDate As Date)
Dim FedOld As Collection
Dim FedNew As Collection
Set FedOld = FedHolidays(StartDate, EndDate)
Set FedNew = FederalHolidays(StartDate, EndDate)
'First, test the counts
If FedNew.Count <> FedOld.Count Then
Throw "Holiday count mismatch. Old: {0}; New: {1}", _
FedOld.Count, FedNew.Count
End If
'Then, test each individual entry in the collections
Dim i As Long
For i = 1 To FedOld.Count
If FedOld(i) <> FedNew(i) Then
Throw "Expected: {0}; Actual: {1}", _
FedOld(i), FedNew(i)
End If
Next i
Debug.Print FedOld.Count; " tests passed"
End Sub
' ----------------------------------------------------------------
' Procedure : FederalHolidays
' Date : 2/6/2021
' Author : Mike Wolfe
' Source : https://nolongerset.com/calculating-holidays-in-vba/
' Purpose : Returns a collection of calculated dates that represent federal holidays
' 2/14/23 : Added support for Juneteenth, observed on or about June 19, beginning in 2021.
' 2/14/23 : Also added start years to all other holidays.
' ----------------------------------------------------------------
Function FederalHolidays(StartDate As Date, EndDate As Date) As Collection
Set FederalHolidays = New Collection
Dim StartYear As Integer: StartYear = Year(StartDate)
Dim EndYear As Integer: EndYear = Year(EndDate)
Dim Yr As Integer
For Yr = StartYear To EndYear
Dim i As Integer
For i = 1 To 11
Dim Dt As Date
Select Case i
Case 1 'New Year's Day
If Yr < 1871 Then GoTo NextHoliday
Dt = GetHolidayObservanceDate(DateSerial(Yr, 1, 1))
Case 2 'Birthday of Martin Luther King, Jr.
'3rd Monday of January
If Yr < 1986 Then GoTo NextHoliday
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 1, Yr)
Case 3 'Washington's Birthday
'3rd Monday of February
If Yr < 1879 Then GoTo NextHoliday
Dt = OrdinalWeekdayOfMonth(3, vbMonday, 2, Yr)
Case 4 'Memorial Day
If Yr < 1868 Then GoTo NextHoliday
If Yr < 1971 Then
'Observed on May 30th from 1868 to 1970
Dt = GetHolidayObservanceDate(DateSerial(Yr, 5, 30))
Else
'Last Monday of May
Dt = OrdinalWeekdayOfMonth(5, vbMonday, 5, Yr)
End If
Case 5 'Juneteenth National Independence Day
'Juneteenth was first celebrated as a federal holiday in 2021
If Yr < 2021 Then GoTo NextHoliday
Dt = GetHolidayObservanceDate(DateSerial(Yr, 6, 19))
Case 6 'Independence Day
If Yr < 1870 Then GoTo NextHoliday
Dt = GetHolidayObservanceDate(DateSerial(Yr, 7, 4))
Case 7 'Labor Day
'1st Monday of September
If Yr < 1894 Then GoTo NextHoliday
Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
Case 8 'Columbus Day
'2nd Monday of October
If Yr < 1971 Then GoTo NextHoliday
Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
Case 9 'Veterans Day
If Yr < 1954 Then GoTo NextHoliday
If Yr < 1971 Then
Dt = GetHolidayObservanceDate(DateSerial(Yr, 11, 11))
ElseIf Yr < 1978 Then
'Observed the fourth Monday of October from 1971 - 1977
Dt = OrdinalWeekdayOfMonth(4, vbMonday, 10, Yr)
Else
Dt = GetHolidayObservanceDate(DateSerial(Yr, 11, 11))
End If
Case 10 'Thanksgiving Day
If Yr < 1870 Then GoTo NextHoliday
'4th Thursday of November
Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
Case 11 'Christmas Day
If Yr < 1870 Then GoTo NextHoliday
Dt = GetHolidayObservanceDate(DateSerial(Yr, 12, 25))
End Select
If Dt >= StartDate And Dt <= EndDate Then
FederalHolidays.Add Dt
End If
NextHoliday:
Next i
Next Yr
End Function
'Returns the Nth weekday of a given month and year
' - Pass a 5 for Nth to get the last instance of that weekday in the given month
'>>> OrdinalWeekdayOfMonth(3, 2, 1, 2020)
' 1/20/2020
'>>> OrdinalWeekdayOfMonth(3, 2, 2, 2020)
' 2/17/2020
'>>> OrdinalWeekdayOfMonth(5, 2, 5, 2020)
' 5/25/2020
'>>> OrdinalWeekdayOfMonth(1, 2, 9, 2020)
' 9/7/2020
'>>> OrdinalWeekdayOfMonth(2, 2, 10, 2020)
' 10/12/2020
'>>> OrdinalWeekdayOfMonth(4, 5, 11, 2020)
' 11/26/2020
Function OrdinalWeekdayOfMonth(Nth As Byte, DayOfWeek As VbDayOfWeek, Mo As Byte, Yr As Integer)
If Nth < 1 Or Nth > 5 Then Throw "Invalid Nth value: {0} (should be 1 - 5)", Nth
If Mo < 1 Or Mo > 12 Then Throw "Invalid Month value: {0} (should be 1 - 12)", Mo
If Yr < 100 Or Yr > 9999 Then Throw "Invalid Year value: {0} (should be 100 - 9999)", Yr
Dim i As Integer, TempDate As Date
For i = 0 To 6
If Nth = 5 Then 'Last weekday of the month
TempDate = MonthEnd(DateSerial(Yr, Mo, 1)) - i
Else 'Nth weekday of the month
TempDate = DateSerial(Yr, Mo, (7 * (Nth - 1) + 1)) + i
End If
If Weekday(TempDate) = DayOfWeek Then
OrdinalWeekdayOfMonth = TempDate
Exit Function
End If
Next i
End Function
'Returns the observance of a federal holiday by adjusting for
' dated holidays that fall on a weekend
' - If the holiday falls on a Saturday, return the prior Friday
' - If the holiday falls on a Sunday, return the following Monday
' - If the holiday falls on a weekday, return the same date
'>>> GetHolidayObservanceDate(#7/4/1997#)
' 7/4/1997
'>>> GetHolidayObservanceDate(#7/4/1998#)
' 7/3/1998
'>>> GetHolidayObservanceDate(#7/4/1999#)
' 7/5/1999
Function GetHolidayObservanceDate(DateOfActualHoliday As Date) As Date
Select Case Weekday(DateOfActualHoliday)
Case vbSaturday
GetHolidayObservanceDate = DateOfActualHoliday - 1
Case vbSunday
GetHolidayObservanceDate = DateOfActualHoliday + 1
Case Else
GetHolidayObservanceDate = DateOfActualHoliday
End Select
End FunctionImage by Free-Photos from Pixabay
UPDATE [2023-02-14]: Updated to include Juneteenth and year checks for all federal holidays.