Using TDD to Calculate Holidays in VBA

This article takes you step-by-step through the Test Driven Design process, unencumbered by the complexity of any sort of testing framework.

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:

  1. Write tests that will only pass with properly written code
  2. Run the tests to ensure they fail
  3. 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:

  1. First, we test the total count in each collection
  2. 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 Sub

Step 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 Function

If we run the TestFedHolidays() function now we get the following results:

Holiday count mismatch. Old: '340'; 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 Function

Note 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 10
            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 'Independence Day
                Dt = DateSerial(Yr, 7, 4)
            
            Case 6 'Labor Day
                '1st Monday of September
            
            Case 7 'Columbus Day
                '2nd Monday of October
            
            Case 8 'Veterans Day
                Dt = DateSerial(Yr, 11, 11)
            
            Case 9 'Thanksgiving Day
                '4th Thursday of November
            
            Case 10 'Christmas Day
                Dt = DateSerial(Yr, 12, 25)
            
            End Select
            
            FederalHolidays.Add Dt
        Next i

How 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 Function

Of 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 Function

Updating 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 10
        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 'Independence Day
            Dt = DateSerial(Yr, 7, 4)
        
        Case 6 'Labor Day
            '1st Monday of September
            Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
        
        Case 7 'Columbus Day
            '2nd Monday of October
            Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
        
        Case 8 'Veterans Day
            Dt = DateSerial(Yr, 11, 11)
        
        Case 9 'Thanksgiving Day
            '4th Thursday of November
            Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
        
        Case 10 'Christmas Day
            Dt = DateSerial(Yr, 12, 25)
        
        End Select

Now 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 Function

When we incorporate this function into our FederalHolidays() Select..Case statement, 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 'Independence Day
                Dt = GetHolidayObservanceDate(DateSerial(Yr, 7, 4))
            
            Case 6 'Labor Day
                '1st Monday of September
                Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
            
            Case 7 'Columbus Day
                '2nd Monday of October
                Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
            
            Case 8 'Veterans Day
                Dt = GetHolidayObservanceDate(DateSerial(Yr, 11, 11))
            
            Case 9 'Thanksgiving Day
                '4th Thursday of November
                Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
            
            Case 10 'Christmas Day
                Dt = GetHolidayObservanceDate(DateSerial(Yr, 12, 25))
            
            End Select

If I run TestFedHolidays() now, I get the following result:

340  tests passed

Missing 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 Sub

Now, 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 If

Now, if I rerun the TestFedHolidays() function, I get this result:

 340  tests passed
 3  tests passed

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

'Returns a collection of calculated dates that represent federal 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 10
            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 'Independence Day
                Dt = GetHolidayObservanceDate(DateSerial(Yr, 7, 4))
            
            Case 6 'Labor Day
                '1st Monday of September
                Dt = OrdinalWeekdayOfMonth(1, vbMonday, 9, Yr)
            
            Case 7 'Columbus Day
                '2nd Monday of October
                Dt = OrdinalWeekdayOfMonth(2, vbMonday, 10, Yr)
            
            Case 8 'Veterans Day
                Dt = GetHolidayObservanceDate(DateSerial(Yr, 11, 11))
            
            Case 9 'Thanksgiving Day
                '4th Thursday of November
                Dt = OrdinalWeekdayOfMonth(4, vbThursday, 11, Yr)
            
            Case 10 'Christmas Day
                Dt = GetHolidayObservanceDate(DateSerial(Yr, 12, 25))
            
            End Select
            If Dt >= StartDate And Dt <= EndDate Then
                FederalHolidays.Add Dt
            End If
        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 Function

Image by Free-Photos from Pixabay

Comments

Sign in or become a No Longer Set member to join the conversation.
Just enter your email below to get a log in link. (This will also subscribe you to my weekly newsletter.)