Working with Workdays

Many calculations involve the five typical workdays (Monday through Friday), but VBA doesn’t provide any support for this subset of dates. The functions in this section provide information about the next and previous workday and finding the first and last workday in a month. Skipping weekend days is simple and not worthy of much explanation. The hard part is dealing with the other factor affecting these calculations: holidays. VBA is blissfully unaware of the real world and knows nothing of national and religious holidays. Supplying that information is up to you, and the functions presented here count on your having created a DAO recordset object filled with the rows of information about holidays. You needn’t supply a recordset if you don’t need this functionality; the recordset parameter to the functions shown here is optional. If you do supply a reference to an open recordset, you must also pass in the name of the field containing holiday date information so the code knows the field in which to search.

Because all the functions in this section count on the same support routines, it makes sense to explain these underlying procedures first. The first routine, IsWeekend, shown in Listing 2.8, accepts a date parameter and returns True if the date falls on a weekend and False otherwise.

Listing 2.8: Indicate Whether a Date Falls on a Weekend

Private Function IsWeekend(dtmTemp As Date) As Boolean
    ' If your weekends aren't Saturday (day 7)
    ' and Sunday (day 1), change this routine
    ' to return True for whatever days
    ' you DO treat as weekend days.
    Select Case WeekDay(dtmTemp)
        Case vbSaturday, vbSunday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
End Function

The second support function, SkipHolidays (shown in Listing 2.9), takes a reference to a recordset, a field to search in, a date value, and the number of days to skip (normally +1 or –1). It skips over weekend days and holidays until it finds a date that is neither a weekend nor a holiday. It skips past increments of the parameter passed in, so the same code can be used to skip forward or backward.

Listing 2.9: Move a Date Value over Holidays and Weekends

Private Function SkipHolidays(rst As Recordset, _
 strField As String, dtmTemp As Date, intIncrement As Integer) _
 As Date
    ' Skip weekend days, and holidays in the
    ' recordset referred to by rst.
    Dim strCriteria As String
    On Error GoTo HandleErr
    ' Move up to the first Monday/last Friday if the first/last
    ' of the month was a weekend date. Then skip holidays.
    ' Repeat this entire process until you get to a weekday.
    ' Unless rst contains a row for every day in the year (!)
    ' this should finally converge on a weekday.
    Do
        Do While IsWeekend(dtmTemp)
            dtmTemp = dtmTemp + intIncrement
        Loop
        If Not rst Is Nothing Then
            If Len(strField) > 0 Then
                If Left(strField, 1) <> "[" Then
                    strField = "[" & strField & "]"
                End If
                Do
                    strCriteria = strField & _
                     " = #" & Format(dtmTemp, "mm/dd/yy") & "#"
                    rst.FindFirst strCriteria
                    If Not rst.NoMatch Then
                        dtmTemp = dtmTemp + intIncrement
                    End If
                Loop Until rst.NoMatch
            End If
        End If
    Loop Until Not IsWeekend(dtmTemp)
ExitHere:
    SkipHolidays = dtmTemp
    Exit Function

HandleErr:
    ' No matter what the error, just
    ' return without complaining.
    ' The worst that could happen is that the code
    ' includes a holiday as a real day, even if
    ' it's in the table.
    Resume ExitHere
End Function

The code starts out by skipping over any weekend days. If you send it a date that falls on a weekend, this first bit of code will loop until it lands on a non-weekend date:

Do While IsWeekend(dtmTemp)
    dtmTemp = dtmTemp + intIncrement
Loop

Its next task is to ensure that the recordset variable is instantiated, that it points to something, and that the field name has been supplied. Once that happens, if the field name doesn’t include a leading [ character, the code adds leading and trailing brackets. This guards against problems that can occur if the field name includes spaces.

If Not rst Is Nothing Then
    If Len(strField) > 0 Then
        If Left(strField, 1) <> "[" Then
            strField = "[" & strField & "]"
        End If

Finally, the code enters the loop shown below, checking for a match in the recordset against the current value of dtmTemp. If the code finds a match in the table, it moves to the next day and tries again. It continues in this way until it no longer finds a match in the table. Most of the time, however, this code will execute only once. (There are very few, if any, occurrences of consecutive holidays.) Normally, there won’t be any match, and the code will drop right out. If a match is found in the table, there’s rarely more than one. Unless you add a row to the table for each day of the year, this code should be extremely fast.

Do
    strCriteria = strField & _
     " = #" & Format(dtmTemp, "mm/dd/yy") & "#"
    rst.FindFirst strCriteria
    If Not rst.NoMatch Then
        dtmTemp = dtmTemp + intIncrement
    End If
Loop Until rst.NoMatch

Because this step could drop you off on a weekend date, the entire process repeats until you run out of holidays and don’t end up on a weekend date. Of course, the outer loop most likely is never going to be used, but it takes care of an important problem.

The code in this example won’t do you any good if the Jet database engine is not available to you. If you don’t have this database engine (although anyone using Microsoft Office most likely does), you can either rewrite the code to use whatever database engine you do have or just not pass anything for the optional recordset parameter. In that case, you won’t be able to skip holidays, but the code will still correctly skip weekend dates.

Finding the Next, Previous, First, or Last Workday in the Month

Once you’ve got the routines to skip holidays, the rest is simple. If you need to find the previous or next workday, it’s just a matter of skipping weekends and holidays until you find another workday. For example, the procedures in Listing 2.10 find the next or previous workday simply by calling the SkipHolidays function. In each case, the functions accepts three optional parameters:

A date, indicating the month in which to search. If this parameter is omitted, the code uses the current date.
An open recordset, containing holiday information. If this parameter is omitted, the code skips just weekends, not holidays. If it is supplied, you must supply the field name in the next parameter.
A string containing the name of a field to be searched in the open recordset. This parameter is used only if the recordset parameter isn’t omitted, and it is required if you supply the recordset.

As you can see from the code in Listing 2.10, there’s not much to these routines, given the workhorse procedure, SkipHolidays.

Listing 2.10: Find the Next or Previous Workday

Function dhNextWorkday(Optional dtmDate As Date = 0, _
 Optional rst As Recordset = Nothing, _
 Optional strField As String = "") As Date
    ' Return the next working day after the specified date.
    Dim dtmTemp As Date
    Dim strCriteria As String
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dhNextWorkday = SkipHolidays(rst, strField, dtmDate + 1, 1)
End Function
Function dhPreviousWorkday(Optional dtmDate As Date = 0, _
 Optional rst As Recordset = Nothing, _
 Optional strField As String = "") As Date
    Dim dtmTemp As Date
    Dim strCriteria As String
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dhPreviousWorkday = SkipHolidays(rst, strField, _
     dtmDate - 1, -1)
End Function

If you want to find the first or last workday in a given month, all you need to do is maneuver to the first or last day in the month and then skip holidays forward or backward. For example, the dhFirstWorkdayInMonth function, shown in Listing 2.11, handles this for you. The function accepts the same three optional parameters as the previous examples.

The dhFirstWorkdayInMonth function first finds the first day in the month, using the same code as in other procedures in this chapter. Once it gets to the first day, it calls SkipHolidays, passing the recordset, the field name, the starting date, and the increment (1, in this case). The date returned from SkipHolidays will be the first working day in the month.

Listing 2.11: Find the First Workday in a Given Month

Function dhFirstWorkdayInMonth(Optional dtmDate As Date = 0, _
 Optional rst As Recordset = Nothing, _
 Optional strField As String = "") As Date
    ' Return the first working day in the month specified.
    Dim dtmTemp As Date
    Dim strCriteria As String
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
    dhFirstWorkdayInMonth = SkipHolidays(rst, strField, _
     dtmTemp, 1)
End Function

Finding the last workday in the month is very similar. In dhLastWorkdayInMonth, shown in Listing 2.12, the code first finds the final day of the month, using code discussed earlier in this chapter, and then calls the SkipHolidays function to move backward through the month until it finds a day that is neither a weekend nor a holiday.

Listing 2.12: Find the Last Workday in a Given Month

Function dhLastWorkdayInMonth(Optional dtmDate As Date = 0, _
 Optional rst As Recordset = Nothing, _
 Optional strField As String = "") As Date
    ' Return the last working day in the month specified.
    Dim dtmTemp As Date
    Dim strCriteria As String
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
    dhLastWorkdayInMonth = SkipHolidays(rst, strField, _
     dtmTemp, -1)
End Function

To work with these procedures, you might write a test routine like the one shown in Listing 2.13. This procedure assumes the following:

You have Jet and DAO installed on your machine.
You have a reference set to the DAO type library in your project.
You have a database named HOLIDAYS.MDB available (and you’ve modified the code to point to the actual location of HOLIDAYS.MDB).
HOLIDAYS.MDB includes a table named tblHolidays.
tblHolidays includes a date/time field named Date, containing one row for each holiday you want tracked.

Listing 2.13: Test Routine for the SkipHolidays Function

Sub TestSkipHolidays()
    Dim rst As DAO.Recordset
    Dim db As DAO.Database
    Set db = DAO.DBEngine.OpenDatabase("Holidays.MDB")
    Set rst = db.OpenRecordset("tblHolidays", _
     DAO.dbOpenDynaset)
    Debug.Print dhFirstWorkdayInMonth(#1/1/97#, rst, "Date")
    Debug.Print dhLastWorkdayInMonth(#12/31/97#, rst, "Date")
    Debug.Print dhNextWorkday(#5/23/97#, rst, "Date")
    Debug.Print dhNextWorkday(#5/27/97#, rst, "Date")
    Debug.Print dhPreviousWorkday(#5/27/97#, rst, "Date")
    Debug.Print dhPreviousWorkday(#5/23/97#, rst, "Date")
End Sub

If you don’t have Jet and DAO or you just don’t care about holidays, you could also call these routines like this:

Debug.Print dhFirstWorkdayInMonth(#1/1/97#)
' or
Debug.Print dhLastWorkdayInMonth(#12/31/97#)

In this case, the procedure calls would just skip weekend days, if necessary, to return the first and last workday, respectively.

The sample CD with this book includes HOLIDAYS.MDB (which contains tblHolidays), which you can use as a start for preparing your list of holidays. If you have any product that can work with Access databases, you’re ready to start filling in your own list of holidays for use with these routines. If not, we’ve included HOLIDAYS.TXT, a text file you can import into your own database program for use with these samples. Of course, if you’re not using Jet as your database engine, you’ll need to modify the code in the samples accordingly.