Find end date given startdate in MS ACCESS

Question

I'm attempting to write a formula that rounds an end date it to the nearest workday given the start date. I will want the flexibility to add the number of days to start date. For example, if I have the dates November 27, 2021 (which is a Saturday) and November 28, 2021 (which is a Sunday) I want the formula to return November 29, 2021 (Monday). However, if the date November 26, 2021 return same date since it’s a working day. The date will also move to the next working day if the Date is a holiday. Thanks

Public Function AddDueDate(StartDate As Date, TotalPeriold As Integer) As Date

Dim rst As Recordset
Dim db As Database
Dim Duedate As Date
Dim icount As Integer

On Error GoTo errhandlers:
Set db = CurrentDb
Set rst = db.OpenRecordset("tblHolidays", dbOpenSnapshot)
icount = 0
Duedate = StartDate


Do While icount < TotalPeriod
Duedate = Duedate + 1

If Weekday(Duedate, vbMonday) < 6 Then
rst.FindFirst "[Holidaydate]=#" & Duedate & "#"
If rst.NoMatch Then
icount = icount + 1
End If
End If
Loop

AddDueDate = Duedate

exit_errhandlers:
rst.Close
Set rst = Nothing
Set db = Nothing
Exit Function
errhandlers:
MsgBox Err.Description, vbExclamation
Resume Next
End Function

Answer 1

You can obtain that with a combo of my functions found in my project at VBA.Date:

WorkdayDate = DateAddWorkdays(Abs(Not IsDateWorkday(YourDate)), YourDate)

which will add zero days to a date of a workday but, for a non-workday, return the following date of workday.

Full code is too much to post here, but this is the core function:

' Adds Number of full workdays to Date1 and returns the found date.
' Number can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are counted as workdays.
'
' For excessive parameters that would return dates outside the range
' of Date, either 100-01-01 or 9999-12-31 is returned.
'
' Will add 500 workdays in about 0.01 second.
'
' Requires table Holiday with list of holidays.
'
' 2021-12-09. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateAddWorkdays( _
    ByVal Number As Long, _
    ByVal Date1 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Date
    
    Const Interval      As String = "d"
    
    Dim Holidays()      As Date

    Dim Days            As Long
    Dim DayDiff         As Long
    Dim MaxDayDiff      As Long
    Dim Sign            As Long
    Dim Date2           As Date
    Dim NextDate        As Date
    Dim DateLimit       As Date
    Dim HolidayId       As Long

    Sign = Sgn(Number)
    NextDate = Date1
    
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date1 + MaxDayDiff.
            ' Calculate the maximum calendar days per workweek.
            If (WorkDaysPerWeek - HolidaysPerWeek) > 1 Then
                MaxDayDiff = Number * DaysPerWeek / (WorkDaysPerWeek - HolidaysPerWeek)
            Else
                MaxDayDiff = Number * DaysPerWeek
            End If
            ' Add one week to cover cases where a week contains multiple holidays.
            MaxDayDiff = MaxDayDiff + Sgn(MaxDayDiff) * DaysPerWeek
            
            If Sign > 0 Then
                If DateDiff(Interval, Date1, MaxDateValue) < MaxDayDiff Then
                    MaxDayDiff = DateDiff(Interval, Date1, MaxDateValue)
                End If
            Else
                If DateDiff(Interval, Date1, MinDateValue) > MaxDayDiff Then
                    MaxDayDiff = DateDiff(Interval, Date1, MinDateValue)
                End If
            End If
            Date2 = DateAdd(Interval, MaxDayDiff, Date1)
            ' Retrive array with holidays.
            Holidays = DatesHoliday(Date1, Date2)
        End If
        Do Until Days = Number
            If Sign = 1 Then
                DateLimit = MaxDateValue
            Else
                DateLimit = MinDateValue
            End If
            If DateDiff(Interval, DateAdd(Interval, DayDiff, Date1), DateLimit) = 0 Then
                ' Limit of date range has been reached.
                Exit Do
            End If
            
            DayDiff = DayDiff + Sign
            NextDate = DateAdd(Interval, DayDiff, Date1)
            Select Case Weekday(NextDate)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    ' Check for holidays to skip.
                    ' Ignore error when using LBound and UBound on an unassigned array.
                    On Error Resume Next
                    For HolidayId = LBound(Holidays) To UBound(Holidays)
                        If Err.Number > 0 Then
                            ' No holidays between Date1 and Date2.
                        ElseIf DateDiff(Interval, NextDate, Holidays(HolidayId)) = 0 Then
                            ' This NextDate hits a holiday.
                            ' Subtract one day before adding one after the loop.
                            Days = Days - Sign
                            Exit For
                        End If
                    Next
                    On Error GoTo 0
                    Days = Days + Sign
            End Select
        Loop
    End If
    
    DateAddWorkdays = NextDate

End Function