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.