MS ACCESS VBA, working days function incl. holiday when faling on weekend

Question

When deploying MSDN function for calculating working days, beside a problem with date formatting I found an issue with Holiday count.

Calculation is correct, but only if

Answer 1

You can use the function below to get the number of working days (excluding public holidays) between two dates.

It requires a table named tbHolidays with a single field named _Date which holds the public holidays.

Public Function WorkingDaysInDateRange(ByVal DateFrom As Date, _
                                       ByVal DateTo As Date, _
                                       Optional ByVal includeStartDate As Long = 0) As Long
    On Error GoTo ErrorTrap

    'Calculate the number of days
    Dim lngTotalDays As Long
        lngTotalDays = DateDiff("y", DateFrom, DateTo) + includeStartDate

    'Calculate the number of weekend days.
    Dim lngWeekendDays As Long
        lngWeekendDays = (DateDiff("ww", DateFrom, DateTo) * 2) + _
                          IIf(DatePart("w", DateFrom) = vbSunday, 1, 0) + _
                          IIf(DatePart("w", DateTo) = vbSaturday, 1, 0)

    'Get Non working days count from tbHolidays excluding weekends
    Dim lngHolidays As Long
        lngHolidays = DCount("[_Date]", "tbHolidays", _
                             StringFormat("[_Date] Between #{0}# AND #{1}# AND Weekday([_Date]) Not In ({2}, {3})", Format(DateFrom, "mm/dd/yyyy"), _
                                                                                                                    Format(DateTo, "mm/dd/yyyy"), _
                                                                                                                    vbSaturday, vbSunday))
    Dim lngWrkDays As Long
        lngWrkDays = lngTotalDays - (lngWeekendDays + lngHolidays)

    'Return
    WorkingDaysInDateRange = lngWrkDays

Leave:
    On Error GoTo 0
    Exit Function

ErrorTrap:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Function

---

The helper StringFormat function:

Public Function StringFormat(ByVal Item As String, ParamArray args() As Variant) As String

    Dim idx As Long
    For idx = LBound(args) To UBound(args)
        Item = Replace(Item, "{" & idx & "}", args(idx))
    Next idx

    StringFormat = Item
End Function