calculating a date while taking into account holidays

Boy, that's embarrassing. I was positive that I changed that line of code when you posted it originally because you even said to. Obviously I did not change it like I thought I had.

I changed it to the name of the transitdays control and it still works; however, it is still not bringing up the correct value unfortunately. It appears as though it ONLY takes into account the transit days and nothing else (weekends, etc).

For example, If I enter a duedate of 3/30 (which is a Monday) your code returns 3/29 (which is Sunday) it should return 3/27 (Friday).

Edit: After playing around with some other customers of varying transit days, it seems to only have an issue with customers whose transitday value is 1. Every other transitday value seems to work correctly

Ok, I see what the problem is. The formula fails to check the special status of Monday as the 'remaining day', ie. if Monday happens to be the day after shipping.

Code:
Public Function LatestShipDate(DueDate As Date, TransitDays As Integer) As Date
    Dim i As Integer, z As Integer, tdate As Date
 
    tdate = DueDate
    i = TransitDays
    Do
        z = DCount("*", "tblHolidays", "HolidayDate = #" & Format(tdate, "mm/dd/yyyy") & "#")
        If z = 1 Then
           tdate = tdate - 1
        ElseIf Weekday(tdate, vbSaturday) < 3 Then
           tdate = tdate - Weekday(tdate, vbSaturday)
        Else
            i = i - 1
           tdate = tdate - 1
           [COLOR=red]If i = 0 And Weekday(tdate, vbSaturday) = 2 Then[/COLOR]
[COLOR=red]           tdate = tdate - 2[/COLOR]
[COLOR=red]        End If[/COLOR]
        End If
     Loop Until i = 0
    LatestShipDate = tdate
End Function

Ok, so the highlighted added code in the routine handles the situation (incidentally, you would get the same wrong reading if the due date was 31/3 and transit days were 2, etc.). If the day after ship date falls on Monday, the ship date is Friday, not Sunday. This is what the red text says. Hope, I got it right, now :)

Best,
Jiri
 
Edit: Originally, I thought your latest edition to the code made everything work perfectly; however, a co-worker has brought it to my attention that your code allows the scheduled ship date to fall on a holiday as defined by my holidays table. I would like it so that a scheduledshipdate can NOT be on a weekend or a holiday.

In my opinion, nothing in VBA is "simple" but is there a "simple" solution to this? If it is more than just changing/adding a line or 2 of code, then please do not worry about it as it does not take much effort for someone to think to themselves that if the ship date falls on a holiday, it should be shipped a day earlier.

You have been more than enough help to me today and I feel bad for continually adding to this code.
 
Last edited:
Edit: Originally, I thought your latest edition to the code made everything work perfectly; however, a co-worker has brought it to my attention that your code allows the scheduled ship date to fall on a holiday as defined by my holidays table. I would like it so that a scheduledshipdate can NOT be on a weekend or a holiday.

In my opinion, nothing in VBA is "simple" but is there a "simple" solution to this? If it is more than just changing/adding a line or 2 of code, then please do not worry about it as it does not take much effort for someone to think to themselves that if the ship date falls on a holiday, it should be shipped a day earlier.

You have been more than enough help to me today and I feel bad for continually adding to this code.

No need to apologize. I took it on, so I am going to finish it. I realized the same thing just a few moments after I sent you the latest edit. Of course, if a holiday occurs the day after scheduled ship day we are in the same mess as with Mondays. Luckily, it is easy to fix the code for the US....not so easy for Canada where we are running into a recursive problem with two consecutive holidays (Dec 25 and 26). I will send you the US solution for now until I find a better formula that works everywhere.

Code:
Public Function LatestShipDate(DueDate As Date, TransitDays As Integer) As Date
    Dim i As Integer, z As Integer, tdate As Date
 
    tdate = DueDate
    i = TransitDays
    Do
        z = DCount("*", "tblHolidays", "HolidayDate = #" & Format(tdate, "mm/dd/yyyy") & "#")
        If z = 1 Then
           tdate = tdate - 1
        ElseIf Weekday(tdate, vbSaturday) < 3 Then
           tdate = tdate - Weekday(tdate, vbSaturday)
        Else
            i = i - 1
           tdate = tdate - 1
           [COLOR=seagreen]If i = 0 Then[/COLOR]
[COLOR=seagreen]              z = DCount("*", "tblHolidays", "HolidayDate = #" & Format(tdate, "mm/dd/yyyy") & "#")[/COLOR]
[COLOR=seagreen]              If z = 1 Then[/COLOR]
[COLOR=seagreen]                 tdate = tdate - 1[/COLOR]
[COLOR=seagreen]              End If[/COLOR]
[COLOR=seagreen]              If Weekday(tdate, vbSaturday) = 2 Then[/COLOR]
[COLOR=seagreen]                tdate = tdate - 2[/COLOR]
[COLOR=seagreen]              End If[/COLOR]
[COLOR=seagreen]           End If[/COLOR]
        End If
     Loop Until i = 0
    LatestShipDate = tdate
End Function

Good luck with it !

Best,
Jiri
 
Thank you so much. Thankfully, we are a small company in the US so that solution works for us.

I have tested various holidays/transit days/etc well into the year 2018 and everything seems to work perfectly.

You have been an immense help!

Cheers,
Bryan
 
Thank you so much. Thankfully, we are a small company in the US so that solution works for us.

I have tested various holidays/transit days/etc well into the year 2018 and everything seems to work perfectly.

You have been an immense help!

Cheers,
Bryan

My pleasure, Bryan.

Best,
Jiri
 
Hi Bryan,
I went at it again this morning to figure out why the routine did not work with the Canadian holiday calendar. I discovered that there was a hidden bug in the code which would make the function fail under certain circumstances. For the US, it would not correctly interpret "Day 0" (the shipping day) as a holiday if it fell on Friday. This is because the bottom loop test (of day i=0) works reliably only if weekend precedes a holiday.
Try a due date of a Monday if it falls on 7th of July (ie. July 4th on Friday) with transit days = 1. I rewrote the function and hopefully, this is the end of job. :cool:

Code:
Private Function LatestShipDate(DueDate As Date, TransitDays As Integer) As Date
    Dim i As Integer, z As Integer, tdate As Date, Released As Boolean
 
    tdate = DueDate
    i = TransitDays
    Do
        z = DCount("*", "tblHolidays", "HolidayDate = #" & Format(tdate, "mm/dd/yyyy") & "#")
        If z = 1 Then
           tdate = tdate - 1
       ElseIf Weekday(tdate, vbSaturday) < 3 Then
         tdate = tdate - 1
       ElseIf i = 0 Then
           Released = True
        Else
           i = i - 1
           tdate = tdate - 1
        End If
     Loop Until i = 0 And Released
    LatestShipDate = tdate
End Function

Best,
Jiri
 

Users who are viewing this thread

Back
Top Bottom