Problems on my function with dates

[nilses]

Hello,

I have a problem concerning one of my functions and I think that you could help me. I was helped on this site by TimK and Harry of the site access-programmers to carry out the beginning then I progress on my function by myself.

This function makes the difference between two dates by delete saturdays afternoons, Sundays and the bank holidays. I use also a timetable, I take into account only these schedules.

which are:

StartDate: 09:00:00
LunchStart: 12:00:00
LunchEnd: 13:30:00
HeureFin: 17:30:00
EndDate = 07:00:00

My StartDate is 07:00:00 and for my calculates StartDate = 09:00:00.

My problem is as follows:

If I take the example of one day:
StartDate: 14/06/2003 08:00:00
EndDate: 16/06/2003 08:00:00

I must find as a second = 10800
I find with my function = 36000

For me, I must only keep saturdays morning and to delete saturdays after midday, Sunday but him it keeps Monday. I think the problem is when i delete the saturday afternoon.

Could you look at my code to see or I must improve it Thank you for your assistance. Here the code which I use. In the field result, i use the second format. My Country Option is the european format jj/mm/aa hh:mm:ss and when i change, the result is not the same if i use the English format in country option.

'This function calcul the difference between two dates
'The day is composed like this
'DayStart = "09:00:00"
'LunchStart = "12:00:00"
'LunchEnd = "13:30:00"
'DayEnd = "17:30:00"

'I subtract the saturday afternoon (13:30:00 - 17:30:00) and the sunday

My function is too long and i can't post the function. You can see my function in VBA. The name on my function is TimeWorkedSeconds3

Thanks for your help

Nilses

 

[Tim K.]

Hello Nilses,

It's me again. Sorry for leaving you high and dry.

Check the revised code below.

Function BetweenHoursInSecond(DateStart As Date, DateEnd As Date) As Long
    Dim lngSeconds As Long, lngHours As Long, intHour As Variant
    Dim IntWeek As Integer, intCount As Integer
    
    ' Check if the DateStart falls behind 9 am.
    If Format(DateStart, "hh:mm:ss") < "09:00:00" Then
        ' Start it at 9 am of today's date.
        DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("09:00:00")
    ' Check if the DateStart falls after 17.30.
    ElseIf Format(DateStart, "hh:mm:ss") > "17:30:00" Then
        ' Shift it to the next day at 9 am.
        DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart) + 1) + CDate("09:00:00")
    End If
    
    ' Check if the DateEnd falls after 17.30.
    If Format(DateEnd, "hh:mm:ss") > "17:30:00" Then
        ' Shift it back 17.30.
        DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("17:30:00")
    ' Check if the DateEnd falls before 9 am.
    ElseIf Format(DateEnd, "hh:mm:ss") <= "09:00:00" Then
        ' Shift it back to the day before at 17.30.
        DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd) - 1) + CDate("17:30:00")
    End If
    
    Debug.Print "Before 9 After 1730"
    Debug.Print DateStart & " " & DateEnd
    
    ' Check if both dates are in lunch break.
    If Format(DateStart, "hh:mm:ss") >= "12:00:00" And Format(DateStart, "hh:mm:ss") < "13:30:00" Then
        DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("13:30:00")
    End If

    If Format(DateEnd, "hh:mm:ss") > "12:00:00" And Format(DateEnd, "hh:mm:ss") < "13:30:00" Then
        DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("12:00:00")
    End If
    
    Debug.Print "Lunch break"
    Debug.Print DateStart & " " & DateEnd
    
    ' Check if the DateStart/DateEnd is on Sunday.
    If Format(DateStart, "ddd") = "sun" Then
        ' Shift it to Monday at 9 am.
        DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart) - 1) + CDate("12:00:00")
    End If
    If Format(DateEnd, "ddd") = "sun" Then
        ' Shift it to Monday at 9 am.
        DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd) - 1) + CDate("12:00:00")
    End If
    Debug.Print "If Sunday"
    Debug.Print DateStart & " " & DateEnd
    
    ' Check if the DateStart/DateEnd is on Saturday afternoon.
    If Format(DateStart, "ddd") = "sat" Then
        ' Shift down to Saturday at noon.
        If DateStart > DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("12:00:00") Then
            DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("12:00:00")
        End If
    End If
    If Format(DateEnd, "ddd") = "sat" Then
        ' Shift down to Saturday at noon.
        If DateEnd > DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("12:00:00") Then
            DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("12:00:00")
        End If
    End If
    Debug.Print "If  Saturday afternoon"
    Debug.Print DateStart & " " & DateEnd
    
    If DateEnd < DateStart Then
        Exit Function
    End If
    
    intHour = 0
    intHour = DateDiff("d", DateStart, DateEnd)
    Debug.Print "intHour =" & intHour
    If intHour > 0 Then
        lngSeconds = DateDiff("s", DateStart, DateSerial(Year(DateStart), _
            Month(DateStart), Day(DateStart)) + CDate("17:30:00")) + _
                DateDiff("s", DateSerial(Year(DateEnd), Month(DateEnd), _
                    Day(DateEnd)) + CDate("09:00:00"), DateEnd)
        Debug.Print "First date diff = " & DateDiff("s", DateStart, DateSerial(Year(DateStart), _
            Month(DateStart), Day(DateStart)) + CDate("17:30:00"))
        Debug.Print "Last date diff = " & DateDiff("s", DateSerial(Year(DateEnd), Month(DateEnd), _
                    Day(DateEnd)) + CDate("09:00:00"), DateEnd)
        intHour = ((intHour - 1) * 8.5)
        Debug.Print "intHour 2=" & intHour
    Else
        lngSeconds = DateDiff("s", DateStart, DateEnd)
    End If
    Debug.Print "lngSeconds " & lngSeconds
    If Len(lngSeconds) > 0 Then
        lngHours = (intHour * 3600) + lngSeconds
    End If
    Debug.Print "First strHours " & lngHours
    
    ' Check for number of day(s) between the 2 dates.
    ' Then substract the lunch break time.
    ' 12 - 13.30 = 5400 seconds.
    ' Presumed that lunch break of the first and last dates are included.
    intCount = DateDiff("d", DateStart, DateEnd) + 1
    Debug.Print DateStart & " <--> " & DateEnd
    Debug.Print "intCount 1 " & intCount
    ' Substract the last day lunch break out if it's before noon.
    If DateEnd <= DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("12:00:00") _
        And DateStart <= DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("12:00:00") Then
        intCount = intCount - 1
    End If
    Debug.Print "intCount 11 " & intCount
    ' Substract the first day lunch break out if it's in afternoon.
    If DateEnd >= DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("13:30:00") _
        And DateStart >= DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("13:30:00") Then
        intCount = intCount - 1
    End If
    
    lngHours = lngHours - (intCount * 5400)
    Debug.Print "strHours after lunch break " & lngHours
    
    ' Check if the 2 dates are included any weekends.
    IntWeek = 0
    DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart))
    DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd))
    Do While DateStart <= DateEnd
        If Format(DateStart, "ddd") = "sun" Then
            IntWeek = IntWeek + 1
        End If
        DateStart = DateAdd("d", 1, DateStart)
    Loop
    Debug.Print "intWeek " & IntWeek
    
    ' Substract the weekend(s).
    ' Sat. 13.30 - 17.30 = 14400 seconds.
    ' Sunday = 8.5 * 3600 = 30600 seconds.
    ' But Sunday's lunch break was substracted,
    ' so Sunday has 30600 - 5400 = 25200 seconds left.
    ' Total = 14400 + 25200
    lngHours = lngHours - (IntWeek * 39600)
    Debug.Print "After intWeek strHours " & lngHours
    
    BetweenHoursInSecond = lngHours
End Function

I have very limited test on it. Here what I have done.

? BetweenHoursInSecond(#13/6/2003 12:00:00#,#15/6/2003 09:00:00#)

It returns 25200

? BetweenHoursInSecond(#13/6/2003 11:00:00#,#15/6/2003 09:00:00#)

It returns 28800

? BetweenHoursInSecond(#13/6/2003 11:00:00#,#16/6/2003 9:00:01#)

It returns 28801

It might look messy to you by you can remove the Debug.Print lines out.