Problems on my function with dates (1 Viewer)

nilses

Registered User.
Local time
Today, 15:41
Joined
Jan 2, 2003
Messages
45
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.

Code:
'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
 

Attachments

  • mytestv2.zip
    18.4 KB · Views: 170

Tim K.

Registered User.
Local time
Today, 15:41
Joined
Aug 1, 2002
Messages
242
Hello Nilses,

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

Check the revised code below.

Code:
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.
 

Users who are viewing this thread

Top Bottom