Microsoft Access, Office/VBA, VB6 Modules royalty-free source code library

Microsoft Access Modules royalty-free source code library

Microsoft Access VBA and VB6 Module Library

Free trial of Total Visual SourceBook for Microsoft Access, Office, VB6 and VBA

Adding (and Subtracting) Weekdays in Microsoft Access, VBA, and VB6

Provided by: Luke Chung, FMS President

Microsoft Access, VBA, and VB6 include a wide range of built-in Date functions, including DateAdd, which calculates the difference between two dates. A common need, however, is to add a number of weekdays to a date, without counting weekend dates.

The following function adds the specified number of weekdays to a date. You can pass a negative number of days subtract.

Public Function AddWeekdays(datDateIn As Date, intDays As Integer) As Date
  ' Comments: Add or subtract a number of weekdays to a date.
  '           Weekend dates are not counted in adding/subtracting days.
  ' Params  : datDateIn       Starting date
  '           intDays         Number of days to add (negative to subtract)
  ' Returns : Original date plus the number of weekdays added
  ' Source  : Total Visual SourceBook

  On Error GoTo PROC_ERR

  Dim intCounter As Integer
  Dim intDirection As Integer
  Dim datNewDate As Date
  Dim lngWeeks As Long
  Dim intDaysLeft As Integer

  datNewDate = datDateIn

  If intDays > 0 Then
    intDirection = 1
  Else
    intDirection = -1
  End If
  lngWeeks = Fix(Abs(intDays) / 5)

  If lngWeeks > 0 Then
    datNewDate = datNewDate + lngWeeks * 7 * intDirection
  End If

  intDaysLeft = Abs(intDays) - lngWeeks * 5

  For intCounter = 1 To intDaysLeft
    datNewDate = datNewDate + 1 * intDirection
    If intDirection > 0 Then
      ' Increment date
      If Weekday(datNewDate) = 7 Then
        datNewDate = datNewDate + 2
      End If
    Else
      ' Decrement date
      If Weekday(datNewDate) = 1 Then
        datNewDate = datNewDate - 2
      End If
    End If
  Next intCounter

  AddWeekdays = datNewDate

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.AddWeekdays"
  Resume PROC_EXIT
End Function

Below is an example of calling the function:

' Calculate the due date of an item as 15 weekdays from today
Dim datDueDate As Date

datDueDate = AddWeekdays(Date, 15)
MsgBox "The item is due on: " & vbCrLf & datDueDate

This code and much more is available in Total Visual SourceBook.

Total Visual SourceBook also include two modules to perform real business day math where a list of holidays is kept either in a table or file. By using the list of holidays you specify, you can take into account weekdays that shouldn't be counted because your organization is closed. The Business Day routines let you:

Calculate the number of business days between two dates
Add or subtract a certain number of business days to a date
Count the number of business days in a month
See if a specific day is a business day and if not, move backward or forward to the next business day
Calculate holidays for national holidays (e.g. the holiday for July 4th if it falls on a weekend)
First or last business day of a week or month