Why does my CalcWorkingDays VBA Function give me two different results on the same period?

Question

First of all, I'm a beginner and still learning VBA, thank you for your consideration.

I have a CalcWorkingDays function which which calculates working days within a specific period (period defined by a query parameter).

But when it returns results, for some periods it is completely correct, and for some others it's incorrect (See example at the end)

I guess the problem is in these lines :

If Format(DateCnt, "w") <> "7" And _
    Format(DateCnt, "w") <> "6" Then

Thank you !

Public Function CalcWorkingDays(BegDate As Variant, EndDate As Variant) As Integer

 Dim WholeWeeks As Variant
 Dim DateCnt As Variant
 Dim EndDays As Integer

 On Error GoTo Err_Work_Days

 BegDate = DateValue(BegDate)
 EndDate = DateValue(EndDate)
 WholeWeeks = DateDiff("w", BegDate, EndDate)
 DateCnt = DateAdd("ww", WholeWeeks, BegDate)
 EndDays = 0

 Do While DateCnt <= EndDate
 If Format(DateCnt, "w") <> "7" And _
 Format(DateCnt, "w") <> "6" Then
 EndDays = EndDays + 1
 End If
 DateCnt = DateAdd("d", 1, DateCnt)
 Loop

 CalcWorkingDays = WholeWeeks * 5 + EndDays

Exit Function

[...]
End Function`

For example, on march 2019. there is a total of 21 working days. We have both employees A and B A : he's on a project from 01/01/2019 to 31/12/2019, the function gives me 21 working days for march which is correct B : He's been assigned to a project from 01/03/2019 to 08/03/2019, it gives me 5 which is incorrect, it should give me 6 (8 total days days - 2 days for week end

Answer 1

Maybe you try to use function networkdays

=NETWORKDAYS(start_date,end_date,holidays)

holidays is optional

For example, if you have the date January 4, 2016 (a Monday) in cell B4, and January 11, 2016 (also a Monday) in cell C4, this formula will return 6:

=NETWORKDAYS(B4,C4)

for VBA in ACCESS

Sub test()
    Dim xl As Object
    Set xl = CreateObject("Excel.Application")
        BegDate = #4/11/2019#
        EndDate = #6/11/2019#
        result = xl.WorksheetFunction.NetworkDays(BegDate, EndDate) ' 44
    Set xl = Nothing
End Sub

OR

this one

Answer 2

The function gives me 21 working days for march which is correct B

He's been assigned to a project from 01/03/2019 to 08/03/2019, it gives me 5 which is incorrect, it should give me 6.

A diff-function will never include the last date. If you wish to include that last date, add one day to the last date before calculating:

? DateDiffWorkDays(#2019/03/01#, #2019/03/31#)
 21 
? DateDiffWorkDays(#2019/03/01#, #2019/04/01#)
 21 

? DateDiffWorkDays(#2019/03/01#, #2019/03/08#)
 5 
? DateDiffWorkDays(#2019/03/01#, #2019/03/09#)
 6

Also, as already noted, specify Monday as the first day of the week. Further, don't use Format; Weekday is the "direct" method. Thus:

If Weekday(DateCnt, vbMonday) < 6 Then
    EndDays = EndDays + 1
End If

For an extended method that takes holidays into account, study my functions:

Option Compare Database
Option Explicit

' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
'   Mo  Tu  We  Th  Fr  Sa  Su      Su  Sa  Fr  Th  We  Tu  Mo
'    0   1   2   3   4   4   4       0   0  -1  -2  -3  -4  -5
'
'   Su  Mo  Tu  We  Th  Fr  Sa      Sa  Fr  Th  We  Tu  Mo  Su
'    0   1   2   3   4   5   5       0  -1  -2  -3  -4  -5  -5
'
'   Sa  Su  Mo  Tu  We  Th  Fr      Fr  Th  We  Tu  Mo  Su  Sa
'    0   0   1   2   3   4   5       0  -1  -2  -3  -4  -4  -4
'
'   Fr  Sa  Su  Mo  Tu  We  Th      Th  We  Tu  Mo  Su  Sa  Fr
'    0   0   0   1   2   3   4       0  -1  -2  -3  -3  -3  -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Long

    Dim Holidays()      As Date

    Dim Diff            As Long
    Dim Sign            As Long
    Dim NextHoliday     As Long
    Dim LastHoliday     As Long

    Sign = Sgn(DateDiff("d", Date1, Date2))
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date2.
            Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
            ' Ignore error when using LBound and UBound on an unassigned array.
            On Error Resume Next
            NextHoliday = LBound(Holidays)
            LastHoliday = UBound(Holidays)
            ' If Err.Number > 0 there are no holidays between Date1 and Date2.
            If Err.Number > 0 Then
                WorkOnHolidays = True
            End If
            On Error GoTo 0
        End If

        ' Loop to sum up workdays.
        Do Until DateDiff("d", Date1, Date2) = 0
            Select Case Weekday(Date1)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    If WorkOnHolidays = False Then
                        ' Check for holidays to skip.
                        If NextHoliday <= LastHoliday Then
                            ' First, check if NextHoliday hasn't been advanced.
                            If NextHoliday < LastHoliday Then
                                If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
                                    ' Weekend hasn't advanced NextHoliday.
                                    NextHoliday = NextHoliday + 1
                                End If
                            End If
                            ' Then, check if Date1 has reached a holiday.
                            If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
                                ' This Date1 hits a holiday.
                                ' Subtract one day to neutralize the one
                                ' being added at the end of the loop.
                                Diff = Diff - Sign
                                ' Adjust to the next holiday to check.
                                NextHoliday = NextHoliday + 1
                            End If
                        End If
                    End If
                    Diff = Diff + Sign
            End Select
            ' Advance Date1.
            Date1 = DateAdd("d", Sign, Date1)
        Loop
    End If

    DateDiffWorkdays = Diff

End Function

' Returns the holidays between Date1 and Date2.
' The holidays are returned as an array with the
' dates ordered ascending, optionally descending.
'
' The array is declared static to speed up
' repeated calls with identical date parameters.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function GetHolidays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal OrderDesc As Boolean) _
    As Date()

    ' Constants for the arrays.
    Const DimRecordCount    As Long = 2
    Const DimFieldOne       As Long = 0

    Static Date1Last        As Date
    Static Date2Last        As Date
    Static OrderLast        As Boolean
    Static DayRows          As Variant
    Static Days             As Long

    Dim rs                  As DAO.Recordset

    ' Cannot be declared Static.
    Dim Holidays()          As Date

    If DateDiff("d", Date1, Date1Last) <> 0 Or _
        DateDiff("d", Date2, Date2Last) <> 0 Or _
        OrderDesc <> OrderLast Then

        ' Retrieve new range of holidays.
        Set rs = DatesHoliday(Date1, Date2, OrderDesc)

        ' Save the current set of date parameters.
        Date1Last = Date1
        Date2Last = Date2
        OrderLast = OrderDesc

        Days = rs.RecordCount
            If Days > 0 Then
                ' As repeated calls may happen, do a movefirst.
                rs.MoveFirst
                DayRows = rs.GetRows(Days)
                ' rs is now positioned at the last record.
            End If
        rs.Close
    End If

    If Days = 0 Then
        ' Leave Holidays() as an unassigned array.
        Erase Holidays
    Else
        ' Fill array to return.
        ReDim Holidays(Days - 1)
        For Days = LBound(DayRows, DimRecordCount) To UBound(DayRows, DimRecordCount)
            Holidays(Days) = DayRows(DimFieldOne, Days)
        Next
    End If

    Set rs = Nothing

    GetHolidays = Holidays()

End Function

' Returns the holidays between Date1 and Date2.
' The holidays are returned as a recordset with the
' dates ordered ascending, optionally descending.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatesHoliday( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal ReverseOrder As Boolean) _
    As DAO.Recordset

    ' The table that holds the holidays.
    Const Table         As String = "Holiday"
    ' The field of the table that holds the dates of the holidays.
    Const Field         As String = "Date"

    Dim rs              As DAO.Recordset

    Dim SQL             As String
    Dim SqlDate1        As String
    Dim SqlDate2        As String
    Dim Order           As String

    SqlDate1 = Format(Date1, "\#yyyy\/mm\/dd\#")
    SqlDate2 = Format(Date2, "\#yyyy\/mm\/dd\#")
    ReverseOrder = ReverseOrder Xor (DateDiff("d", Date1, Date2) < 0)
    Order = IIf(ReverseOrder, "Desc", "Asc")

    SQL = "Select " & Field & " From " & Table & " " & _
        "Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
        "Order By 1 " & Order

    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

    Set DatesHoliday = rs

End Function

You'll see, that in its core it's nothing but a simple loop, which is so fast that attempts to optimise won't pay off for typical usage.

Answer 3

Date arithmetic is tricky. If you are not hugely concerned about efficiency and your intervals are relatively small then a really simple function will do the trick

Public Function CalcWorkingDays(BegDate As Variant, EndDate As Variant) As Integer
    CalcWorkingDays = 0
    For i = begdate To enddate
        If Weekday(i, vbMonday) <= 5 Then
            CalcWorkingDays = CalcWorkingDays + 1
        End If
    Next
End Function

Not particularly elegant but effective, easy to understand, and easy to modify.

Answer 4

Harassed Dad is right - if you use Format(DateCnt, "w"), Sunday will be "1", Monday "2"... But you shouldn't use Format to get the day of the week - Format is for formatting data into strings, and there is no need to involve strings. Use the Weekday-function instead.

The default behavior for Weekday is that Sunday will be 1 (as a number, not a string), but you can change that with the 2nd parameter (FirstDayOfWeek). This defines which day you want to have as first day of the week.

So you can change your logic for example to

If Weekday(DateCnt, vbMonday) < 6 Then