Networkdays in Access but Using Global Holidays

V

vash011390

Registered User.
Local time
Tomorrow, 04:12
Joined
Jul 29, 2015
Messages
29
Hello,

I want to create a database were I can calculate business days using holidays from 2 or more countries. I am using the below code on calculating business days.

Code: 
Public Function GetNetWorkDays( _
  ByVal datDateFrom As Date, _
  ByVal datDateTo As Date, _
  Optional ByVal booExcludeHolidays As Boolean) _
  As Long
'#39; Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' May be freely used and distributed.
' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen
' 2000-10-03. Constants added.
'             Option for 5 or 6 working days per week added.
' 2008-06-12. Option to exclude holidays from the count of workdays.
  Const cbytWorkdaysOfWeek  As Byte = 5
  ' Name of table with holidays.
  Const cstrTableHoliday    As String = "tbl_eDealHolidays"
  ' Name of date field in holiday table.
  Const cstrFieldHoliday    As String = "holDate"
  Dim bytSunday             As Byte
  Dim intWeekdayDateFrom    As Integer
  Dim intWeekdayDateTo      As Integer
  Dim lngDays               As Long
  Dim datDateTemp           As Date
  Dim strDateFrom           As String
  Dim strDateTo             As String
  Dim lngHolidays           As Long
  Dim strFilter             As String
  
  ' Reverse dates if these have been input reversed.
  If datDateFrom > datDateTo Then
    datDateTemp = datDateFrom
    datDateFrom = datDateTo
    datDateTo = datDateTemp
  End If
  
  ' Find ISO weekday for Sunday.
  bytSunday = Weekday(vbSunday, vbMonday)
  
  ' Find weekdays for the dates.
  intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
  intWeekdayDateTo = Weekday(datDateTo, vbMonday)
  
  ' Compensate weekdays' value for non-working days (weekends).
  intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
  intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)
  
  ' Calculate number of working days between the two weekdays, ignoring number of weeks.
  lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
  ' Add number of working days between the weeks of the two dates.
  lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))
  
  If booExcludeHolidays And lngDays > 0 Then
    strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
    strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
    strFilter = cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
    lngHolidays = DCount("*", cstrTableHoliday, strFilter)
  End If
  
  GetNetWorkDays = lngDays - lngHolidays
End Function

The above code is use only for one set of holiday (using 1 table).
Can someone assist me on modifying this? I intend to put all country holidays on a table and add another column indicating it's country.

Many thanks for the help.
Regards,
Vash
 
Code: 
Public Function GetNetWorkDays2( _
  ByVal datDateFrom As Date, _
  ByVal datDateTo As Date, _
  ByVal strCountry As String, _
  Optional ByVal booExcludeHolidays As Boolean) _
  As Long
'#39; Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' May be freely used and distributed.
' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen
' 2000-10-03. Constants added.
'             Option for 5 or 6 working days per week added.
' 2008-06-12. Option to exclude holidays from the count of workdays.
  Const cbytWorkdaysOfWeek  As Byte = 5
  ' Name of table with holidays.
  Const cstrTableHoliday    As String = "tbl_eDealHolidays"
  ' Name of date field in holiday table.
  Const cstrFieldHoliday    As String = "holDate"
  Const cstrCountryField    As String = "[COLOR=Blue]CountryCode[/COLOR]"
  Dim bytSunday             As Byte
  Dim intWeekdayDateFrom    As Integer
  Dim intWeekdayDateTo      As Integer
  Dim lngDays               As Long
  Dim datDateTemp           As Date
  Dim strDateFrom           As String
  Dim strDateTo             As String
  Dim lngHolidays           As Long
  Dim strFilter             As String
  
  ' Reverse dates if these have been input reversed.
  If datDateFrom > datDateTo Then
    datDateTemp = datDateFrom
    datDateFrom = datDateTo
    datDateTo = datDateTemp
  End If
  
  ' Find ISO weekday for Sunday.
  bytSunday = Weekday(vbSunday, vbMonday)
  
  ' Find weekdays for the dates.
  intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
  intWeekdayDateTo = Weekday(datDateTo, vbMonday)
  
  ' Compensate weekdays' value for non-working days (weekends).
  intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
  intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)
  
  ' Calculate number of working days between the two weekdays, ignoring number of weeks.
  lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
  ' Add number of working days between the weeks of the two dates.
  lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))
  
  If booExcludeHolidays And lngDays > 0 Then
    strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
    strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
    strFilter = "[" & cstrCountryField & "] = '" & strCountry & "' "
    strFilter = strFilter & " And " &  _
            cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
    lngHolidays = DCount("*", cstrTableHoliday, strFilter)
  End If
  
  GetNetWorkDays = lngDays - lngHolidays
End Function

replaced the blue-colored text with the correct name for your country code field in your table. it assumes the field is text.
 
Hello,

I am having a compile error with the code we I run it.
It says "Function call on left side of assignment must return Variant or Object".

I already change the field name but this error won't go.
It ended up closing the application.

Appreciate your assistance again.

Regards,
Vash
 
try using Nz function on this part of the code:

lngHolidays = DCount("*", cstrTableHoliday, strFilter)

to:

lngHolidays = Nz(DCount("*", cstrTableHoliday, strFilter), 0)
 
Hello Arnel,

Many thanks for the assistance.
Error are now gone but some countries do not calculate correctly.

I attached here my current db.

Many thanks,
Vash
 

Attachments

see the the new code i commented out the formatting of date in the code and replaced with english format

see also the new query the last argument for the function must be boolean (true/false).
 

Attachments

Hello Arnel,

Many thanks for your response.
It now calculates on a per country basis.

One more thing, I found a draw back on using the macro. When I manually calculated the diffs using networkdays in excel, there is always a difference of 1 day.

Appreciate your assistance again.

Many thanks.
vash
 
without the functions, manually counting which one is yielding the correct result?
 
Hello Arnel,

Networkdays in Excel includes both the start dates and end dates.

I believe the macro for access only include either start date or end date.

Am not sure if it is or it can count the total holidays and deduct to the total business day.

The correct one is the networkdays in excel.

regards,
Vash
 
does our function yield more than the excel function? here i made some changes, see if it fix:
Code: 
Public Function GetNetWorkDays( _
  ByVal datDateFrom As Date, _
  ByVal datDateTo As Date, _
  ByVal strCountry As String, _
  Optional ByVal booExcludeHolidays As Boolean) _
  As Long
'#39; Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' May be freely used and distributed.
' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen
' 2000-10-03. Constants added.
'             Option for 5 or 6 working days per week added.
' 2008-06-12. Option to exclude holidays from the count of workdays.
  Const cbytWorkdaysOfWeek  As Byte = 5
  ' Name of table with holidays.
  Const cstrTableHoliday    As String = "tbl_eDealHolidays"
  ' Name of date field in holiday table.
  Const cstrFieldHoliday    As String = "holDate"
  Const cstrCountryField    As String = "CountryCode"
  Dim bytSunday             As Byte
  Dim intWeekdayDateFrom    As Integer
  Dim intWeekdayDateTo      As Integer
  Dim lngDays               As Long
  Dim datDateTemp           As Date
  Dim strDateFrom           As String
  Dim strDateTo             As String
  Dim lngHolidays           As Long
  Dim strFilter             As String
  
  Dim strSQL                As String
  Dim rs                    As DAO.Recordset
  
  ' Reverse dates if these have been input reversed.
  If datDateFrom > datDateTo Then
    datDateTemp = datDateFrom
    datDateFrom = datDateTo
    datDateTo = datDateTemp
  End If
  
  ' Find ISO weekday for Sunday.
  bytSunday = Weekday(vbSunday, vbMonday)
  
  ' Find weekdays for the dates.
  intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
  intWeekdayDateTo = Weekday(datDateTo, vbMonday)
  
  ' Compensate weekdays' value for non-working days (weekends).
  intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
  intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)
  
  ' Calculate number of working days between the two weekdays, ignoring number of weeks.
  lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
  ' Add number of working days between the weeks of the two dates.
  lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))
  
  If booExcludeHolidays And lngDays > 0 Then
    strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
    strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
    strFilter = "[" & cstrCountryField & "] = '" & strCountry & "' "
    strFilter = strFilter & " And " & _
            cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
    'lngHolidays = DCount("*", cstrTableHoliday, strFilter)
    strSQL = "SELECT [" & cstrFieldHoliday & "] FROM " & cstrTableHoliday & " " & _
            "WHERE " & strFilter
    Set rs = DBEngine(0)(0).OpenRecordset()
    With rs
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
            If InStr("Saturday/Sunday", Format(rs(0).Value, "dddd")) = 0 Then
                lngHolidays = lngHolidays + 1
            End If
            .MoveNext
        Wend
        .Close
    End If
    Set rs = Nothing
  End If
  
  GetNetWorkDays = lngDays - lngHolidays
End Function
 
if the first one does'nt work, well just do the loop:
Code: 
Public Function GetNetWorkDays( _
          ByVal d1 As Variant, _
            ByVal d2 As Variant, _
                ByVal strCountry As String, _
                    Optional ByVal booExcludeHolidays As Boolean) As Long
    Dim swp As Variant
    Dim i As Variant
    Dim lngDays As Long
    Dim strDateFrom As String
    Dim strDateTo As String
    Dim strFilter As String
    Dim strSQL As String
    Dim lngHolidays As Long
    Dim rs As DAO.Recordset
    
    ' Name of table with holidays.
    Const cstrTableHoliday    As String = "tbl_eDealHolidays"
    ' Name of date field in holiday table.
    Const cstrFieldHoliday    As String = "holDate"
    Const cstrCountryField    As String = "CountryCode"
    
    If IsNull(d1) Then d1 = Date
    If IsNull(d2) Then d2 = Date
    If d1 > d2 Then
        swp = d1
        d1 = d2
        d2 = swp
    End If
    d1 = CDate(d1)
    d2 = CDate(d2)
    For i = d1 To d2
        If InStr("Saturday/Sunday", Format(i, "dddd")) = 0 Then
            lngDays = lngDays + 1
        End If
    Next
    
  If booExcludeHolidays And lngDays > 0 Then
    strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
    strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
    strFilter = "[" & cstrCountryField & "] = '" & strCountry & "' "
    strFilter = strFilter & " And " & _
            cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
    'lngHolidays = DCount("*", cstrTableHoliday, strFilter)
    strSQL = "SELECT [" & cstrFieldHoliday & "] FROM " & cstrTableHoliday & " " & _
            "WHERE " & strFilter
    Set rs = DBEngine(0)(0).OpenRecordset()
    With rs
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
            If InStr("Saturday/Sunday", Format(rs(0).Value, "dddd")) = 0 Then
                lngHolidays = lngHolidays + 1
            End If
            .MoveNext
        Wend
        .Close
    End If
    Set rs = Nothing
  End If
    NetworkDays = lngDays - lngHolidays
End Function
 
Hello Arnel,

I tested the two macros.

I encounter compile error on below part of code.

Code: 
Set rs = DBEngine(0)(0).OpenRecordset()

It says Complie error: Argument not optional.

It highlights ".Openrecordset"

Appreciate your assistance again.
 
sorry it should be:

Set rs = DBEngine(0)(0).OpenRecordset(strSQL)
 
Hello Arnel,

After a little bit of excitement on your code, I am block by Block if End IF error.

Am not sure again where it did came from,

Apologies, but can you take a look again.

Regards,
 
thank you for your patience, i have to review the code, somehow there is a mixing of month/day and day/month on the code. please try:
Code: 
Public Function GetNetWorkDays( _
          ByVal datDateFrom As Variant, _
            ByVal datDateTo As Variant, _
                ByVal strCountry As String, _
                    Optional ByVal booExcludeHolidays As Boolean) As Long
    Dim swp As Variant
    Dim i As Variant
    Dim lngDays As Long
    Dim strDateFrom As String
    Dim strDateTo As String
    Dim strFilter As String
    Dim strSQL As String
    Dim lngHolidays As Long
    Dim rs As DAO.Recordset
    Dim tempDate As Date
    
    ' Name of table with holidays.
    Const cstrTableHoliday    As String = "tbl_eDealHolidays"
    ' Name of date field in holiday table.
    Const cstrFieldHoliday    As String = "holDate"
    Const cstrCountryField    As String = "CountryCode"
    
    If IsNull(datDateFrom) Then datDateFrom = Date
    If IsNull(datDateTo) Then datDateTo = Date
    If datDateFrom > datDateTo Then
        swp = datDateFrom
        datDateFrom = datDateTo
        datDateTo = swp
    End If
    datDateFrom = CDate(Format(datDateFrom, "mm/dd/yyyy"))
    datDateTo = CDate(Format(datDateTo, "mm/dd/yyyy"))
    tempDate = datDateFrom
    While tempDate <= datDateTo
        If InStr("/Saturday/Sunday/", Format(tempDate, "dddd")) = 0 Then
            lngDays = lngDays + 1
        End If
        tempDate = DateAdd("d", 1, tempDate)
    Wend
    
  If booExcludeHolidays And lngDays > 0 Then
    strDateFrom = Format(datDateFrom, "mm/dd/yyyy")
    strDateTo = Format(datDateTo, "mm/dd/yyyy")
    strFilter = "[" & cstrCountryField & "] = " & Chr(34) & strCountry & Chr(34) & " "
    strFilter = strFilter & " And " & _
            cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "#;"
    strSQL = "SELECT [" & cstrFieldHoliday & "] FROM [" & cstrTableHoliday & "] " & _
            "WHERE " & strFilter
    Set rs = DBEngine(0)(0).OpenRecordset(strSQL)
    With rs
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
            If InStr("/Saturday/Sunday/", Format(rs(0).Value, "dddd")) = 0 Then
                lngHolidays = lngHolidays + 1
            End If
            .MoveNext
        Wend
        .Close
    End With
    Set rs = Nothing
  End If
    GetNetWorkDays = lngDays - lngHolidays
End Function
 
Hello Arnel,

Many thanks for the quick feedback. :) :)
I really appreciate your help.

I encounter again another error. :(

Run-time error: 3061:
Too few parameters. Expected1
 
Hello Arnel,

I already solved the runtime error. It's a user error. Hehe.

Will do a full test to my database.

Regards,
 
You must log in or register to reply here.

Similar threads

mike60smart
Calculated Total Days Vacation taken
Replies
7
Views
1,555
theDBguy
theDBguy
P
Solved Access Upgrade to 365 (2016) getting compile errors and a notice to update a "Function"
Replies
3
Views
2,183
theDBguy
theDBguy
I
Adding working days to a date, not calculating correctly every time
Replies
6
Views
1,403
Integrate
I
N
Alerts based on current Day/Week of the Month
Replies
7
Views
1,160
NearImpossible
N
P
Reference value of record in a module
Replies
3
Views
559
Ports
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom