505.369.1650 [email protected]

This function finds a date that is a certain number of days from a start date, when weekends are not included.  It can be used when your work week does not include Saturday and Sunday and you want to find a business day in the future.  Microsoft Excel provides the WORKDAY worksheet function, but Microsoft Access does not have a built-in solution.

The function only looks forward; if you use a negative number for NumberDays, it will return a Null value.  It will also return a Null if either of the arguments is Null.


Public Function AddDaysNoWeekends(StartDate, NumberDays)
' This function returns a date that is days away from StartDate, not 
' including Saturday and Sunday.

' AddDaysNoWeekends() Version 1.0.0
' Copyright © 2013 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.

On Error GoTo Err_Handler

    Dim dteDate As Date
    Dim lngDays As Long
    Dim strDay As String

    ' If any of the arguments are Null or NumberDays is negative,
    ' then pass back a Null.
    If IsNull(StartDate) Or IsNull(NumberDays) Or Nz(NumberDays, 0) < 0 Then
        AddDaysNoWeekends = Null
        GoTo Exit_Proc
    End If

    ' Initialize the variables.
    lngDays = 0

    ' If we're at a weekend day, go to the next week day.
    strDay = Format(StartDate, "ddd")
    If strDay = "Sat" Then
        dteDate = StartDate + 2
    ElseIf strDay = "Sun" Then
        dteDate = StartDate + 1
        dteDate = StartDate
    End If

    ' Loop until the number of days is used up.
    Do Until lngDays = NumberDays
        ' Increment the date.
        dteDate = dteDate + 1
        ' If it is a weekend day, go to the next week day.
        strDay = Format(dteDate, "ddd")
        If strDay = "Sat" Then
            dteDate = dteDate + 2
        ElseIf strDay = "Sun" Then
            dteDate = dteDate + 1
        End If
        ' Increment the counter.
        lngDays = lngDays + 1

    AddDaysNoWeekends = dteDate

    On Error Resume Next
    Exit Function

     MsgBox Err.Number & " " & Err.Description, vbCritical, _
    AddDaysNoWeekends = Null
    Resume Exit_Proc
End Function

Download Code: