Number of days between two dates excluding weekends and holidays (1 Viewer)

Moote Tiira

New member
Local time
Today, 05:30
Joined
Aug 23, 2021
Messages
10
Hi everyone,

Can anyone help with a trick to calculate the number of days btw two dates excluding weekends and holidays in ms access?

Thanks
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:00
Joined
May 21, 2018
Messages
5,385
Try this
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 16:00
Joined
May 7, 2009
Messages
13,693
here is one from the book (slightly modified).
Code:
' devHandbook
' count the numbers of workdays between two dates
' modified version (arnelgp)
Public Function dhCountWorkdays( _
                                ByVal dtmStart As Date, ByVal dtmend As Date, _
                                Optional holidayTable As String = "", _
                                Optional strField As String = "") _
                                As Integer
' Count the business days (not counting weekends/holidays) in
' a given date range.
Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer
Dim rst As DAO.recordSet
' Swap the dates if necessary.
If dtmend < dtmStart Then
    dtmTemp = dtmStart
    dtmStart = dtmend
    dtmend = dtmTemp
End If
If Len(holidayTable) Then
    Set rst = CurrentDb.OpenRecordset(holidayTable, dbOpenSnapshot, ReadOnly)
End If
' Get the start and end dates to be weekdays.
dtmStart = SkipHolidays(rst, strField, dtmStart, 1)
dtmend = SkipHolidays(rst, strField, dtmend, -1)
If dtmStart > dtmend Then
    ' Sorry, no Workdays to be had. Just return 0.
    dhCountWorkdays = 0
Else
    intDays = dtmend - dtmStart + 1
    ' Subtract off weekend days. Do this by figuring out how
    ' many calendar weeks there are between the dates, and
    ' multiplying the difference by two (because there are two
    ' weekend days for each week). That is, if the difference
    ' is 0, the two days are in the same week. If the
    ' difference is 1, then we have two weekend days.
    intSubtract = (DateDiff("ww", dtmStart, dtmend) * 2)
    ' The answer to our quest is all the weekdays, minus any
    ' holidays found in the table.
    ' If rst is Nothing, this call won't subtract any dates.
    intSubtract = intSubtract + _
    CountHolidays(rst, strField, dtmStart, dtmend)
    dhCountWorkdays = intDays - intSubtract
End If
Set rst = Nothing
End Function

Private Function CountHolidays(rst As DAO.recordSet, strField As String, dtmStart As Date, dtmend As Date) As Integer
    Dim bolNext As Boolean
    Dim cnt As Integer
    If (rst Is Nothing) Then
        Exit Function
    End If
    With rst
        If Not (.BOF And .EOF) Then
            .MoveFirst
            Do Until .NoMatch
                If bolNext Then
                    .FindNext "[" & strField & "] >= " & Format(dtmStart, "\#mm\/dd\/yyyy\#") & " and " & _
                              "[" & strField & "] <= " & Format(dtmend, "\#mm\/dd\/yyyy\#")
                Else
                    .FindFirst "[" & strField & "] >= " & Format(dtmStart, "\#mm\/dd\/yyyy\#") & " and " & _
                               "[" & strField & "] <= " & Format(dtmend, "\#mm\/dd\/yyyy\#")
                End If
               
                If Not .NoMatch Then
                    cnt = cnt + 1
                End If
            Loop
        End If
    End With
End Function

Private Function SkipHolidays( _
                                rst As DAO.recordSet, strField As String, _
                                dtmTemp As Date, intIncrement As Integer) As Date
    ' modified by arnelgp
    ' dao.recordset
    '
    ' Skip weekend days, and holidays in the recordset
    ' referred to by rst.
    ' Return dtmTemp + as many days as it takes to get to
    ' a day that's not
    ' a holiday or weekend.
    Dim strCriteria As String
    Dim strFieldName As String
    Dim bolNext As Boolean
    On Error GoTo HandleErr
    ' Move up to the first Monday/last Friday, if the first/last
    ' of the month was a weekend date. Then skip holidays.
    ' Repeat this entire process until you get to a weekday.
    ' Unless rst contains a row for every day in the year (!)
    ' this should finally converge on a weekday.
    Do
        Do While IsWeekend(dtmTemp)
            dtmTemp = dtmTemp + intIncrement
        Loop
        If Not rst Is Nothing Then
            If Len(strField) > 0 Then
                strFieldName = strField
                If left$(strField, 1) <> "[" Then
                    strFieldName = "[" & strFieldName & "]"
                End If
                rst.MoveFirst
                strCriteria = strFieldName & " = " & _
                        "#" & Format(dtmTemp, "mm/dd/yyyy") & "#"
                Do
                    If bolNext Then
                        rst.FindNext strCriteria
                    Else
                        rst.FindFirst strCriteria
                    End If
                    If Not rst.NoMatch Then
                        bolNext = True
                        dtmTemp = dtmTemp + intIncrement
                    End If
                Loop Until rst.NoMatch
            End If
        End If
    Loop Until Not IsWeekend(dtmTemp)
ExitHere:
    SkipHolidays = dtmTemp
    Exit Function
HandleErr:
    ' No matter what the error, just
    ' return without complaining.
    ' The worst that could happen is that we
    ' include a holiday as a real day, even if
    ' it's in the table.
    Resume ExitHere
End Function

' is Weekend?
Private Function IsWeekend(dtmTemp As Date) As Boolean
' If your weekends aren't Saturday (day 7)
' and Sunday (day 1), change this routine
' to return True for whatever days
' you DO treat as weekend days.
    Select Case Weekday(dtmTemp)
        Case vbSaturday, vbSunday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
End Function
 
Last edited:

Users who are viewing this thread

Top Bottom