DateAddWorkdays giving inconsistent results - vba

Question

I am using the DateAddWorkdays in my access database that has a SQL backend which works great, most of the time. But I am having some odd inconsistencies and I am not sure why. I have stepped through the script for the past few hours and can't see where the issue is coming from.
I have a table of dates that includes 25th October 2021 as a holiday:
I am using HolidayDate field.
I call the function with
Me.ProductionDate = DateAddWorkdays(-Me.Lag, Me.DelDate)
The number is a negative as I need to count back the number of lag days to know when to start producing the items in time for the delivery date (me.DelDate).
As below, if there are only 2 days it counts back perfectly to 21st October as it removes the 25th being the holiday and the 23rd & 24th as they are weekend days. But if the Lag is 6 days it misses a day somewhere and returns the 18th where I would expect it should return the previous friday the 15th (to test this theory, if I change the delivery date to 27th October it also returns the 18th as a result)
As much as I stepped through the script, I don't fully understand what it is doing so I am hoping someone is able to show me why I am getting this inconsistency.
I have been fiddling around with some date formatting as that was causing issues elsewhere but this script seems to have that incorporated.
Option Compare Database
Option Explicit
Public Function DateAddWorkdays( _
ByVal lngNumber As Long, _
ByVal datDate As Date, _
Optional ByVal booWorkOnHolidays As Boolean) _
As Date
' Adds lngNumber of workdays to datDate.
' 2014-10-03. Cactus Data ApS, CPH
' Calendar days per week.
Const clngWeekdayCount As Long = 7
' Workdays per week.
Const clngWeekWorkdays As Long = 5
' Average count of holidays per week maximum.
Const clngWeekHolidays As Long = 1
' Maximum valid date value.
Const cdatDateRangeMax As Date = #12/31/9999#
' Minimum valid date value.
Const cdatDateRangeMin As Date = #1/1/100#
Dim aHolidays() As Date
Dim lngDays As Long
Dim lngDiff As Long
Dim lngDiffMax As Long
Dim lngSign As Long
Dim datDate1 As Date
Dim datDate2 As Date
Dim datLimit As Date
Dim lngHoliday As Long
lngSign = Sgn(lngNumber)
datDate2 = datDate
If lngSign <> 0 Then
If booWorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between datDate and datDate + lngDiffMax.
' Calculate the maximum calendar days per workweek.
lngDiffMax = lngNumber * clngWeekdayCount / (clngWeekWorkdays - clngWeekHolidays)
' Add one week to cover cases where a week contains multiple holidays.
lngDiffMax = lngDiffMax + Sgn(lngDiffMax) * clngWeekdayCount
datDate1 = DateAdd("d", lngDiffMax, datDate)
aHolidays = GetHolidays(datDate, datDate1)
End If
Do Until lngDays = lngNumber
If lngSign = 1 Then
datLimit = cdatDateRangeMax
Else
datLimit = cdatDateRangeMin
End If
If DateDiff("d", DateAdd("d", lngDiff, datDate), datLimit) = 0 Then
' Limit of date range has been reached.
Exit Do
End If
lngDiff = lngDiff + lngSign
datDate2 = DateAdd("d", lngDiff, datDate)
Select Case Weekday(datDate2)
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 lngHoliday = LBound(aHolidays) To UBound(aHolidays)
If Err.Number > 0 Then
' No holidays between datDate and datDate1.
ElseIf DateDiff("d", datDate2, aHolidays(lngHoliday)) = 0 Then
' This datDate2 hits a holiday.
' Subtract one day before adding one after the loop.
lngDays = lngDays - lngSign
Exit For
End If
Next
On Error GoTo 0
lngDays = lngDays + lngSign
End Select
Loop
End If
DateAddWorkdays = datDate2
End Function
Public Function GetHolidays( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booDesc As Boolean) _
As Date()
' Finds the count of holidays between datDate1 and datDate2.
' The holidays are returned as an array of dates.
' DAO objects are declared static to speed up repeated calls with identical date parameters.
' 2014-10-03. Cactus Data ApS, CPH
' The table that holds the holidays.
Const cstrTable As String = "tblHoliday"
' The field of the table that holds the dates of the holidays.
Const cstrField As String = "HolidayDate"
' Constants for the arrays.
Const clngDimRecordCount As Long = 2
Const clngDimFieldOne As Long = 0
Static dbs As DAO.Database
Static rst As DAO.Recordset
Static datDate1Last As Date
Static datDate2Last As Date
Dim adatDays() As Date
Dim avarDays As Variant
Dim strSQL As String
Dim strDate1 As String
Dim strDate2 As String
Dim strOrder As String
Dim lngDays As Long
If DateDiff("d", datDate1, datDate1Last) <> 0 Or DateDiff("d", datDate2, datDate2Last) <> 0 Then
' datDate1 or datDate2 has changed since the last call.
strDate1 = Format(datDate1, "\#yyyy\/mm\/dd\#")
strDate2 = Format(datDate2, "\#yyyy\/mm\/dd\#")
strOrder = Format(booDesc, "\A\s\c;\D\e\s\c")
strSQL = "Select " & cstrField & " From " & cstrTable & " " & _
"Where " & cstrField & " Between " & strDate1 & " And " & strDate2 & " " & _
"Order By 1 " & strOrder
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
' Save the current set of date parameters.
datDate1Last = datDate1
datDate2Last = datDate2
End If
lngDays = rst.RecordCount
If lngDays = 0 Then
' Leave adatDays() as an unassigned array.
Else
ReDim adatDays(lngDays - 1)
' As repeated calls may happen, do a movefirst.
rst.MoveFirst
avarDays = rst.GetRows(lngDays)
' rst is now positioned at the last record.
For lngDays = LBound(avarDays, clngDimRecordCount) To UBound(avarDays, clngDimRecordCount)
adatDays(lngDays) = avarDays(clngDimFieldOne, lngDays)
Next
End If
' DAO objects are static.
' Set rst = Nothing
' Set dbs = Nothing
GetHolidays = adatDays()
End Function
Further to my question in the comments below, I have come across another example where the calculation is inconsistent. Above is a delivery date of 11/01/2022 which is the 11th January 2022 and with a lag of 2 days it calculates correctly including the holidays from the table below. But a lag anywhere between 9 and 14 and it seems to ignore the holidays but as long as the lag is less than 9 or more than 14 it calculates correctly.

Answer 1

The error is here, where the extended range for possible holidays didn't follow the sign of the date interval, which - in your case - caused the holiday to be excluded:
' Retrieve array with holidays between datDate and datDate + lngDiffMax.
' Calculate the maximum calendar days per workweek.
lngDiffMax = lngNumber * clngWeekdayCount / (clngWeekWorkdays - clngWeekHolidays)
' Add one week to cover cases where a week contains multiple holidays.
'' Missing sign.
'' lngDiffMax = lngDiffMax + clngWeekdayCount
'' Corrected to follow the sign of the date interval.
lngDiffMax = lngDiffMax + Sgn(lngDiffMax) * clngWeekdayCount
datDate1 = DateAdd("d", lngDiffMax, datDate)
aHolidays = GetHolidays(datDate, datDate1)
Now you can run this quick test:
For n = 0 To 7 : ? d, -n, DateAddWorkdays(-n, d) : Next
26-10-2021 0 26-10-2021
26-10-2021 -1 22-10-2021
26-10-2021 -2 21-10-2021
26-10-2021 -3 20-10-2021
26-10-2021 -4 19-10-2021
26-10-2021 -5 18-10-2021
26-10-2021 -6 15-10-2021
26-10-2021 -7 14-10-2021
The function has had a make-over and is included in my project VBA.Date in module DateWork.bas. (Disclaimer: Project holds extensive code written by me).
Extended holidays
Increase the maximum count of possible holidays per week to the count of workdays per week minus one:
' Common constants.
' Workdays per week.
Public Const WorkDaysPerWeek As Long = 5
' Average count of holidays per week maximum.
Public Const HolidaysPerWeek As Long = 4 '1
Now your sample will run like this:
Lag Production Date
--- ---------------
1 10-01-2022
2 21-12-2021
3 20-12-2021
4 17-12-2021
5 16-12-2021
6 15-12-2021
7 14-12-2021
8 13-12-2021
9 10-12-2021
10 09-12-2021
11 08-12-2021
12 07-12-2021
13 06-12-2021
14 03-12-2021
15 02-12-2021
16 01-12-2021