Calculating Working Days from date - giving days 1 day out...?

[BigRods]

Hi,

I've got some code that takes an initial date, then calculates a number of different dates based on a various number of working days after that date.
The problem is that, it's calculating the first 2 dates correctly, then subsequent dates are all 1 day extra than they should be??

My code is as follows - the Date_Notes_Due and Date_Chronology_Due_To_CR fields are fine, it's the dates after. The function beneath checks a table of Public Holidays and makes adjustments accordingly, but there are no public holidays that fall in between
i.e. a record with initial date of 8th Jan 16 - Date Report Due To CR field should be 18th Feb 16 but it's showing 19th Feb 16, and so on.

Can anyone help? It's just odd that it's doing the first 2 fields correctly, then not??!

Case "Natural Causes"
    strSQL = "UPDATE tbl_Death SET Date_Notes_Due = #" & Format(addduedate(Me.txtDateDeath, "2"), "mm/dd/yyyy") & "#," & _
    "Date_Chronology_Due_To_CR = #" & Format(addduedate(Me.txtDateDeath, "10"), "mm/dd/yyyy") & "#," & _
    "Date_Report_Due_From_CR = #" & Format(addduedate(Me.txtDateDeath, "29"), "mm/dd/yyyy") & "#," & _
    "Date_Report_Due_To_QA_Panel = #" & Format(addduedate(Me.txtDateDeath, "30"), "mm/dd/yyyy") & "#," & _
    "Date_Report_Due_From_QA_Panel = #" & Format(addduedate(Me.txtDateDeath, "40"), "mm/dd/yyyy") & "#," & _
    "Date_Report_Due_To_Commissioner = #" & Format(addduedate(Me.txtDateDeath, "45"), "mm/dd/yyyy") & "#," & _
    "Date_Report_Due_To_PPO = #" & Format(addduedate(Me.txtDateDeath, "50"), "mm/dd/yyyy") & "# WHERE tbl_Death.Death_ID = " & Me.txtDeathID & ""

--------------------------------------------------
Public Function addduedate(startdate As Date, numday As Integer) As Date
Dim rst As Recordset
Dim db As Database
Dim duedate As Date
Dim icount As Integer

On Error GoTo errhandlers:
Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_holidays", dbOpenSnapshot)
icount = 0
duedate = startdate
Do While icount < numday
    duedate = duedate + 1
    If Weekday(duedate) > 1 And Weekday(duedate) < 7 Then
        rst.FindFirst "[holidaydate] = #" & duedate & "#"
        If rst.NoMatch Then
            icount = icount + 1
        End If
    End If
Loop
    addduedate = duedate
    
exit_errhandlers:
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Exit Function
errhandlers:
    MsgBox Err.Description, vbExclamation
    Resume Next
End Function

 

[xenou]

i.e. a record with initial date of 8th Jan 16 - Date Report Due To CR field should be 18th Feb 16 but it's showing 19th Feb 16, and so on.

8th Feb to 18th of Feb is 8 days (excluding Sat and Sun).
8th Feb to 19th of Feb is 9 days (excluding Sat and Sun).

None of your function calls include 8 or 9 days as a NumDay parameter.

Please include an example that specifies what the NumDay is supposed to be so the function can be tested against an expected result.

 

[BigRods]

8th Feb to 18th of Feb is 8 days (excluding Sat and Sun).
8th Feb to 19th of Feb is 9 days (excluding Sat and Sun).

None of your function calls include 8 or 9 days as a NumDay parameter.

Please include an example that specifies what the NumDay is supposed to be so the function can be tested against an expected result.

Sorry if that's not clear. The Function "addduedate" referenced in the strSQL string takes the 2 parameters StartDate (as txtDateDeath field) and Numday (as number of working days to be added on). It should then calculate the relevant date from the no. of days specified.

What I'm looking at is:

txtDateDeath = 8th Jan 2016

For the first 2 fields in the strSQL string, the addduedate function calculates the date correctly, then when it gets to the 3rd field - "Date_Report_Due_From_CR", it needs to calculate 29 days later, which is 18th Feb 2016. It's giving me a day later, 19th Feb. Subsequent fields then also appear as a day after they should be.
I hope that explains things??

 

[xenou]

Sorry. Read Jan 8 as Feb 8 for some reason.

I get Feb 18th from your function (jan8 + 29 days, exclude weekdays).

Are you sure there is no holiday?

 

[BigRods]

Sorry. Read Jan 8 as Feb 8 for some reason.

I get Feb 18th from your function (jan8 + 29 days, exclude weekdays).

Are you sure there is no holiday?

My holiday table is all UK dates (dd/mm/yyyy) - there's no holiday between 8th Jan and 18th Feb... BUT... there is a holiday on 2nd May i.e. displayed in the tbl_Holiday table as 02/05/2016. Would this be interfering somehow, and would I need to code something in my Function to get around this at all?

 

[xenou]

Ah. Not good with UK dates and Access. I'd step through the code and see what happens on that day (Feb 5). Rumor has it VBA (not Access, but the VBA components used by Access) treat date literals (#2/5/2016#) as U.S. dates. I would prefer to work with dates using a function such as DateSerial() or non-ambiguous formats such as #Feb 5, 2016#.

 

[BigRods]

Ah. Not good with UK dates and Access. I'd step through the code and see what happens on that day (Feb 5). Rumor has it VBA (not Access, but the VBA components used by Access) treat date literals (#2/5/2016#) as U.S. dates. I would prefer to work with dates using a function such as DateSerial() or non-ambiguous formats such as #Feb 5, 2016#.

Solved it! I made the following amendment on the Function, which accounted for the UK/US date difference:

Public Function addduedate(startdate As Date, numday As Integer) As Date
Dim rst As Recordset
Dim db As Database
Dim duedate As Date
Dim icount As Integer

On Error GoTo errhandlers:
Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_holidays", dbOpenSnapshot)
icount = 0
duedate = startdate
Do While icount < numday
    duedate = duedate + 1
    If Weekday(duedate) > 1 And Weekday(duedate) < 7 Then
        rst.FindFirst "[holidaydate] = #" &  [b]Format(duedate, "mm/dd/yyyy")[/b] & "#"
        If rst.NoMatch Then
            icount = icount + 1
        End If
    End If
Loop
    addduedate = duedate
    
exit_errhandlers:
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Exit Function
errhandlers:
    MsgBox Err.Description, vbExclamation
    Resume Next
End Function

Thanks so much - just needed to post the problem on here, I don't think I would have thought of that on my own!