Stop clock on Working Days

[ProgramRasta]

Hi All,

I'm struggling with amending some code, if anyone has time to look at it, it would be greatly appreciated.

Basically, I have 4 dates.

Date 1 and Date2 return the number of working days in a period (public holidays are passed from an array)

What I want to do is if date 3 and 4 are null - just do date1 and date2 and exit. at the moment I'm getting severe performance issues by the following code.

if date 3 is populated - this acts like a stop on the iterations. if date 4 is populated this restarts the process.

so basically (unless I'm mistaken) - I'm just looking for a datedif(date1, date2) - datedif(date3,date2) + datedif(date4, date2)

Public Function GetWD(ByVal datDate1 As Date, ByVal datDate2 As Date, Optional ByVal datDate3 As Date, Optional ByVal datDate4 As Date) As Long

    Dim Holidays() As Date
    Dim StopClockHolidays() As Date
    Dim RestartClockHolidays() As Date
    Dim TotalDifference As Long
    Dim DayDifference As Long
    Dim TotalDifferenceStop As Long
    Dim DayDifferenceStop As Long
    Dim TotalDifferenceRestart As Long
    Dim DayDifferenceRestart As Long
    Dim BankHoliday  As Long
    Dim BankHolidayStop  As Long
    Dim BankHolidayRestart  As Long
    
    TotalDifferenceStop = 0
    TotalDifferenceRestart = 0
    DayDifferenceStop = 0
    DayDifferenceRestart = 0
    
    DayDifference = Sgn(DateDiff("d", datDate1, datDate2))
    
    If DayDifference <> 0 Then
        Holidays = GetBankHolidays(datDate1, datDate2)
                Do Until DateDiff("d", datDate1, datDate2) = 0
                    Select Case Weekday(datDate1)
                        Case vbSaturday, vbSunday
                        Case Else
                            On Error Resume Next
                            For BankHoliday = LBound(Holidays) To UBound(Holidays)
                                If Err.Number > 0 Then
                                ElseIf DateDiff("d", datDate1, Holidays(BankHoliday)) = 0 Then
                                    TotalDifference = TotalDifference - DayDifference
                                    Exit For
                                End If
                            Next
                            On Error GoTo 0
                            TotalDifference = TotalDifference + DayDifference
                    End Select
            datDate1 = DateAdd("d", DayDifference, datDate1)
        Loop
    End If
    
    GetWD = TotalDifference
    
    If IsNull(datDate3) Then
        Exit Function
    Else
        DayDifferenceStop = Sgn(DateDiff("d", datDate3, datDate2))
        StopClockHolidays = GetBankHolidays(datDate3, datDate2)
            Do Until DateDiff("d", datDate3, datDate2) = 0
                Select Case Weekday(datDate3)
                    Case vbSaturday, vbSunday
                    Case Else
                        On Error Resume Next
                        For BankHolidayStop = LBound(StopClockHolidays) To UBound(StopClockHolidays)
                            If Err.Number > 0 Then
                            ElseIf DateDiff("d", datDate3, StopClockHolidays(BankHolidayStop)) = 0 Then
                                TotalDifferenceStop = TotalDifferenceStop - DayDifferenceStop
                        Exit For
                            End If
                        Next
                        On Error GoTo 0
                        TotalDifferenceStop = TotalDifferenceStop + DayDifferenceStop
                    End Select
            datDate3 = DateAdd("d", DayDifferenceStop, datDate3)
        Loop
    End If
    
    GetWD = TotalDifference - TotalDifferenceStop
    
        If Not IsNull(datDate4) Then
        Exit Function
        Else
        DayDifferenceRestart = Sgn(DateDiff("d", datDate4, datDate2))
        RestartClockHolidays = GetBankHolidays(datDate4, datDate2)
            Do Until DateDiff("d", datDate4, datDate2) = 0
                Select Case Weekday(datDate4)
                    Case vbSaturday, vbSunday
                    Case Else
                        On Error Resume Next
                        For BankHolidayRestart = LBound(RestartClockHolidays) To UBound(RestartClockHolidays)
                            If Err.Number > 0 Then
                            ElseIf DateDiff("d", datDate4, RestartClockHolidays(BankHolidayRestart)) = 0 Then
                                TotalDifferenceRestart = TotalDifferenceRestart - DayDifferenceRestart
                        Exit For
                            End If
                        Next
                        On Error GoTo 0
                        TotalDifferenceRestart = TotalDifferenceRestart + DayDifferenceRestart
                    End Select
            datDate4 = DateAdd("d", DayDifferenceRestart, datDate4)
        Loop
    End If
    
    GetWD = TotalDifference - TotalDifferenceStop + TotalDifferenceRestart

End Function

Many Thanks

 

[June7]

If Not IsNull(datDate4) Then
Exit Function

Why exit if NOT IsNull?

Code continues if datDate4 is null.

 

[ProgramRasta]

If Not IsNull(datDate4) Then
Exit Function

Why exit if NOT IsNull?

Code continues if datDate4 is null.

I was hoping to gain some knowledge/assistance as I'm not experienced with Access. I've simplified the code but I'm getting a type error.

I was hoping I could pass all 4 parameters through the function but if not, if you can explain why I'm getting a type error when I try and subtract

GetWD(date1, date2) - GetWD(date3, date2) -> where the latter should be 0 if date 3 is null?

It would be quite helpful.

thanks

Public Function GetWD(ByVal datDate1 As Date, ByVal datDate2 As Date) As Integer

    Dim Holidays() As Date
    Dim TotalDifference As Long
    Dim DayDifference As Long
    Dim BankHoliday  As Long
    
    If IsNull(datDate1) Then
    GetWD = 0
    Exit Function
    End If
    
    DayDifference = Sgn(DateDiff("d", datDate1, datDate2))
    
    If DayDifference <> 0 Then
        Holidays = GetBankHolidays(datDate1, datDate2)
                Do Until DateDiff("d", datDate1, datDate2) = 0
                    Select Case Weekday(datDate1)
                        Case vbSaturday, vbSunday
                        Case Else
                            On Error Resume Next
                            For BankHoliday = LBound(Holidays) To UBound(Holidays)
                                If Err.Number > 0 Then
                                ElseIf DateDiff("d", datDate1, Holidays(BankHoliday)) = 0 Then
                                    TotalDifference = TotalDifference - DayDifference
                                    Exit For
                                End If
                            Next
                            On Error GoTo 0
                            TotalDifference = TotalDifference + DayDifference
                    End Select
            datDate1 = DateAdd("d", DayDifference, datDate1)
        Loop
    End If
    
    GetWD = TotalDifference
    
End Function

 

[June7]

GetWD expects Date values, cannot pass Null because only Variant variable can hold Null. Passing Null will cause function to error.

DateDiff returns Null if either input is Null.

Arithmetic with Null returns Null.