***NEW CUSTOMER OFFER***
Get 15 minutes of free Live Help!

Use VBA to add days to a date but exclude Saturday and Sunday

0 comments

This function finds a date 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 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.

Code:

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 = (StartDate, "ddd")
    If strDay = "Sat" Then
        dteDate = StartDate + 2
    ElseIf strDay = "Sun" Then
        dteDate = StartDate + 1
    Else
        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 = (dteDate, "ddd")
        If strDay = "Sat" Then
            dteDate = dteDate + 2
        ElseIf strDay = "Sun" Then
            dteDate = dteDate + 1
        End If
        ' Increment the counter.
        lngDays = lngDays + 1
    Loop

    AddDaysNoWeekends = dteDate

Exit_Proc:
    On Error Resume Next
    Exit Function

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

Download Code:

basAddDaysNoWeekends.zip

Leave a Reply

Your email address will not be published. Required fields are marked *

Live Chat Software
%d bloggers like this: