Expression to include holidays > Array question

[Scaniafan]

Hello all,

I'm experiencing a lack of knowledge on my side again...

I've borrowed a piece of code from http://access.mvps.org/access/datetime/date0012.htm.

' ********* Code Start **************
'
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
'

Public Function dhAddWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
    ' Add the specified number of work days to the
    ' specified date.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' In:
    '   lngDays:
    '       Number of work days to add to the start date.
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value, if that's what you want.
    ' Out:
    '   Return Value:
    '       The date of the working day lngDays from the start, taking
    '       into account weekends and holidays.
    ' Example:
    '   dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#, #2/17/2000#))
    '   returns #2/25/2000#, which is the date 10 work days
    '   after 2/9/2000, if you treat 2/16 and 2/17 as holidays
    '   (just made-up holidays, for example purposes only).
    
    ' Did the caller pass in a date? If not, use
    ' the current date.
    Dim lngCount As Long
    Dim dtmTemp As Date
    
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    dtmTemp = dtmDate
    For lngCount = 1 To lngDays
        dtmTemp = dhNextWorkdayA(dtmTemp, adtmDates)
    Next lngCount
    dhAddWorkDaysA = dtmTemp
End Function

There is an array mentioned for holidays. These holidays however are depending on the country where the supplier is based.

Basically, the dates that need to be in the array are dictated by supplier code:

Supplier Code in Document Master Table
provides Country Code based on Supplier Master Table
provides Holidays from Holiday Master Table based on Country Code

How do I need to build my expression in a way that the correct holidays are taken in to account in the dhAddWorkDaysA function?

I currently have below:

Target Date: IIf([TBL_Source_Document_Upload_Margin]![Workday / Calendarday]="workdays";dhAddWorkDaysA([TBL_Source_Document_Upload_Margin]![Margin (days)];IIf([TBL_Source_Document_Upload_Margin]![Departure/arrival]="Departure";[Tbl_Master_CP201]![Departure Date];[TBL_Master_CP201]![Actual Date for END]); "Holidays to be added in array here");IIf([TBL_Source_Document_Upload_Margin]![Workday / Calendarday]="days";DateAdd("d";[TBL_Source_Document_Upload_Margin]![Margin (days)];IIf([TBL_Source_Document_Upload_Margin]![Departure/arrival]="Departure";[Tbl_Master_CP201]![Departure Date];[TBL_Master_CP201]![Actual Date for END]))))

 

[arnelgp]

do you have country code, or supplier code in your TBL_Source_Document_Upload_Margin table?

 

[Scaniafan]

The TBL_Source_Document_Upload_Margin doesn't contain either of them.


TBL_Master_CP201 has (among other non-relevant fields) a document type, supplier code, start and end date

TBL_Source_Document_Upload_Margin has a document type, margin (number of days between start or end) and indicator if the base date is the start or end date. It also includes an indicator if the margin is to be calculated in working days or calendar days.

TBL_Source_Freight_Forwarder has the supplier code and country code

 

[jdraw]

What exactly are you trying to do in plain English?

It may be helpful if you could post the table designs for each table. Or your relationships window as a jpg.

 

[arnelgp]

what are the fields in your tables,:

supplier master
holiday master

 

[Scaniafan]

My apologies for the late reply, I just found out the message board alerts where sent to an old email address...


In plain English, what I'm trying to do is the following:

- I have a table with suppliers, including a supplier code and a country code.
- I have a table with dates (dd-mm-yyyy format) and a country code
- I have a table with supplier code and start date

The start date triggers a target date when documents are to be uploaded. This target date is calculated by adding a given amount of working days to the start date. However, based on the country where the supplier is located, there might be a holiday involved. For example, 4th of July in the US.

I've got the working day calculation functioning with the function I mention in my startpost.

In the function, there is an array that can be populated with dates, being holidays. This funtions as well, if I put manually dates in there in the format #dd-mm-yyy#

I would like to populate the dates in the array based on the dates in the holiday table, triggered by the country code of the supplier.

If the line in TBL_Source_Document_Upload_Margin contains a supplier code of a supplier based in NL (supplier table match on supplier code), the array should be populated with all NL holidays (holiday table match on country code).

what are the fields in your tables,:

supplier master
holiday master

Supplier Master:

- Country Code
- City
- Supplier Full Name
- Supplier Code

Holiday Master:

- Country > contains full country name
- Country Code > contains 2 digit ISO country code
- Description > contains name of holiday (e.g. Easter)
- Date > contains date of holiday in dd-mm-yyyy format

 

[arnelgp]

put this in a Module:

Public Function fnGetHolidays(strSupplierCode As Variant) As Variant

    Dim strSQL As String
    Dim db As Dao.Database
    Dim rs As Dao.Recordset
    
    Dim arrHolidays() As Date
    Dim i As Integer
    
    strSupplierCode = LTrim(RTrim(strSupplierCode & ""))
    
    If strSupplierCode <> "" Then
    
        Set db = CurrentDb
        
        strSQL = "Select [Holiday Master].[Date] From [Supplier Master] " & _
        "Inner Join [Holiday Master] On [Supplier Master].[Country Code] = [Holiday Master].[Country Code] Where [Supplier Master].[Supplier Code] = " & strSupplierCode & ";"
        
        Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
        
        With rs
            If .RecordCount > 0 Then
                .MoveFirst
                ReDim arrHoliday(.RecordCount - 1)
                i = 0
                While Not .EOF
                    arrHolidays(i) = !Date
                    i = i + 1
                    .MoveNext
                Wend
            End If
        End With
        
        fnGetHolidays = arrHolidays
    
    End If

End Function

the call this function in your query:

Target Date: IIf([TBL_Source_Document_Upload_Margin]![Workday / Calendarday]="workdays";dhAddWorkDaysA([TBL_Source_Document_Upload_Margin]![Margin (days)];IIf([TBL_Source_Document_Upload_Margin]![Departure/arrival]="Departure";[Tbl_Master_CP201]![Departure Date];[TBL_Master_CP201]![Actual Date for END]); fnGetHolidays([TBL_Master_CP201]![SUPPLIER CODE]));IIf([TBL_Source_Document_Upload_Margin]![Workday / Calendarday]="days";DateAdd("d";[TBL_Source_Document_Upload_Margin]![Margin (days)];IIf([TBL_Source_Document_Upload_Margin]![Departure/arrival]="Departure";[Tbl_Master_CP201]![Departure Date];[TBL_Master_CP201]![Actual Date for END]))))

 

[Scaniafan]

Thank you arnelgp. I've put the statement in a module, however, when I run it, I get the error

Run-time error '3061'

To few parameters. Expected 1.

I've been renaming my tables as below, but changed all the names as you have them in your statement as well.

[Supplier Master] > [TBL_Source_Freight_Forwarder]

![Supplier Code] > ![Forwarder Code]​

[Holiday Master] > [TBL_Source_Holidays]

[TBL_Master_CP201]![SUPPLIER CODE] as used in the function fnGetHolidays([TBL_Master_CP201]![SUPPLIER CODE]) is renamed to [TBL_Master_CP201]![Forwarding agent]

 

[arnelgp]

have it highlighted the code that causes the error.

 

[Scaniafan]

When debugging it highlights:

Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

 

[arnelgp]

try reproducing the error. on vbe immediate window, type:
?strSQL

copy and post the result here.

 

[Scaniafan]

Did that, when I press enter it prints:

Select [TBL_Source_Holidays].[Date] From [TBL_Source_Freight_Forwarder] Inner Join [TBL_Source_Holidays] On [TBL_Source_Freight_Forwarder].[Country Code] = [TBL_Source_Holidays].[Country Code] Where [TBL_Source_Freight_Forwarder].[Forwarder Code] = DHLAIR;

 

[arnelgp]

ok, your forwarder code is Text, i thought its number. can you please replace strSQL with:

strSQL = "Select [Holiday Master].[Date] From [Supplier Master] " & _
"Inner Join [Holiday Master] On [Supplier Master].[Country Code] = [Holiday Master].[Country Code] Where [Supplier Master].[Supplier Code] = '" & strSupplierCode & "';"

 

[Scaniafan]

Ok, it now continues to a new error.

Run-time error '9':

Subscript out of range

And when I click debug it highlights

arrHolidays(i) = !Date

Can it be that I have to much data to be placed in the array?

 

[arnelgp]

remove this:

Dim i as Integer

then update to the code below:

        With rs
            If .RecordCount > 0 Then
                .MoveFirst
                ReDim arrHoliday(0)
                While Not .EOF
                    arrHolidays(UBound(arrHolidays)) = ![Date]
                    .MoveNext
                    If Not .EOF Then ReDim Preserve arrHolidays(UBound(arrHolidays) + 1)
                Wend
            End If
        End With

 

[Scaniafan]

Unfortunately still the same error message, now highlighting

arrHolidays(UBound(arrHolidays)) = ![Date]

 

[arnelgp]

ok sorry, replace this:

Redim arrHoliday(0)

to:

Redim arrHolidays(0)

 

[Scaniafan]

It now seems to run without giving error messages. However, if I run the formula as below (simple test expression):

Test: dhAddWorkDaysA(2;Date();fnGetHolidays([TBL_Master_CP201]![Forwarding agent]))

This should, based on the country of the forwarding agent of that line being Belgium and tomorrow being a holiday in Belgium, return 13-nov-2015. However, it returns #Error.

I really appreciate the time you are spending to help a noob like me on this!

 

[arnelgp]

last resort, is it possible for you to upload your db.

 

[Scaniafan]

I'm going to give this thread a kick in the ass...

I've had some PM with Arnelgp about this a while ago which solved almost every issue I had with this question. Arnelgp came with the code at the bottom of this thread which works like a charm. However, I've come up to one instance where it doesn't work, and that is when the start date is the holiday itself.

The expression that I'm using is

Target Date Test: IIf(IsNull([QRY_Gross_Performance_1]![Actual Date for END]);Null;IIf([QRY_Gross_Performance_1]![Actual Time for END]<=#12:00:00#;fnSpecialDate([QRY_Gross_Performance_1]![POD Margin];[TBL_Source_Freight_Forwarder]![Country Code];[QRY_Gross_Performance_1]![Actual Date for END]);fnSpecialDate([QRY_Gross_Performance_1]![POD Margin]+1;[TBL_Source_Freight_Forwarder]![Country Code];[QRY_Gross_Performance_1]![Actual Date for END])))

Examples:

- Start date 04-may-2016 before 12:00 hours returns 04-may-2016 as date which is correct as I only need to have the next working day if the time is after 12:00

- Start date 04-may-2016 after 12:00 hours returns 06-may-2016 as date which is correct as I want to have the next working day and 05-may-2016 is a holiday

- Start date 05-may-2016 after 12:00 returns 06-may-2016 which is correct as it should go to the next day anyway, and 06-may-2016 is no holiday

- Start date 05-may-2016 before 12:00 returns 05-may-2016 which is not correct, due to 05-may-2016 being a holiday it should return 06-may-2016

Public Function fnGetHolidays(varCountryCode As Variant, dDate As Variant) As Variant

    Dim strSQL As String
    Dim rs As DAO.Recordset
    Dim strCountryCode As String
    Dim arrHolidays() As Variant
        
    varCountryCode = Trim(varCountryCode & "")
    dDate = CDate(dDate)
    If varCountryCode <> "" Then
    
        If db Is Nothing Then Set db = CurrentDb
        
        strSQL = "Select [Date] From [TBL_Source_Holidays] " & _
                        "Where [Country Code] = '" & varCountryCode & "' " & _
                        "And Year(#" & dDate & "#) >= Year([Date]);"
        Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
            
        With rs
            If .RecordCount > 0 Then
                .MoveLast
                ReDim arrHolidays(0) As Variant
                .MoveFirst
                While Not .EOF
                    arrHolidays(UBound(arrHolidays)) = CDate(![Date].Value)
                    .MoveNext
                    If Not .EOF Then ReDim Preserve arrHolidays(UBound(arrHolidays) + 1) As Variant
                Wend
            End If
        End With
        
        fnGetHolidays = arrHolidays
    
    End If
    
End Function

Public Function fnSpecialDate(lngCount As Long, varCountryCode As Variant, Optional dDate As Date = 0) As Date
'Test: dhAddWorkDaysA(2,[Date],fnGetHolidays([TBL_Master_CP201]![Forwarding agent]))
Dim arrDates() As Variant
arrDates = fnGetHolidays(varCountryCode, dDate)
fnSpecialDate = CDate(dhAddWorkDaysA(lngCount, dDate, arrDates))

End Function