Working with Workdays

[sukishan]

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 FunctionThe 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 FunctionThe 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
LoopIts 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 IfFinally, 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.NoMatchBecause 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.