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.
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 = Format(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 = 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 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