The function does't run in the last part

[nilses]

Hello,

I have make a function (Thanks TIMK From UtterAccess) which make the difference between two dates and which takes only into account a time zone 9H00 - 17H30 and that function perfectly (example if I make the difference between these two hours 8H00 - 20H00, I takes only 9H00 - 17H30). I wanted to improve my function by taking account the midday from 12H00 to 13H30 and if i sum-up, one day is 9h00-12h00// 13H30 - 17H30.

This function run perfectly for one day but not for most days.

Here the examples which pose problems to me:
Date_Start----------------------Date_End---------------Count in second
10/03/03 11:00:00-------11/03/03 10:30:00----------------28800
It must count 1 meal then it counts 2 of them

10/03/03 15:00:00-------12/03/03 16:00:00----------------54000
It must count 2 meal then it counts 3 of them

10/03/03 16:00:00-------13/03/03 17:00:00----------------79200
It must count 3 meal then it counts 4 of them

For me these errors are normal !!


//This part run

Function BetweenHoursInSecond(DateStart As Date, DateEnd As Date) As String
Dim lngSeconds As Long, strHours As String, intHour As Variant, intHour2 As Variant, intHour3 As Variant

' When the DateStart is before 09:00:00

If Format(DateStart, "hh:mm:ss") < "09:00:00" Then
DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("09:00:00")
ElseIf Format(DateStart, "hh:mm:ss") > "17:30:00" Then
DateStart = DateSerial(Year(DateStart), Month(DateStart), Day(DateStart)) + CDate("17:30:00")
End If


' When the DateEnd is after 18:00:00
If Format(DateEnd, "hh:mm:ss") > "17:30:00" Then
DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("17:30:00")
ElseIf Format(DateEnd, "hh:mm:ss") < "09:00:00" Then
DateEnd = DateSerial(Year(DateEnd), Month(DateEnd), Day(DateEnd)) + CDate("09:00:00")
End If

intHour = 0
intHour = DateDiff("d", DateStart, DateEnd)
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)
intHour = ((intHour - 1) * 8.5)
Else
lngSeconds = DateDiff("s", DateStart, DateEnd)
End If

If Len(lngSeconds) > 0 Then
strHours = (intHour * 3600) + lngSeconds
End If



//This part run

intHour2 = 0
intHour3 = 0
intHour2 = DateDiff("d", DateStart, DateEnd)
If intHour2 = 0 Then
If Format(DateStart, "hh:mm:ss") >= "09:00:00" And Format(DateEnd, "hh:mm:ss") <= "12:00:00" Then
intHour3 = 0
ElseIf Format(DateStart, "hh:mm:ss") >= "13:30:00" And Format(DateEnd, "hh:mm:ss") <= "17:30:00" Then
intHour3 = 0
ElseIf Format(DateStart, "hh:mm:ss") >= "09:00:00" And Format(DateEnd, "hh:mm:ss") <= "17:30:00" Then
intHour3 = 5400
End If



//This part doesn't run

ElseIf intHour2 > 0 Then

If Format(DateStart, "hh:mm:ss") >= "09:00:00" And Format(DateEnd, "hh:mm:ss") <= "12:00:00" Then
intHour3 = 0
ElseIf Format(DateStart, "hh:mm:ss") >= "13:30:00" And Format(DateEnd, "hh:mm:ss") <= "17:30:00" Then
intHour3 = 0
ElseIf Format(DateStart, "hh:mm:ss") >= "09:00:00" And Format(DateEnd, "hh:mm:ss") <= "17:30:00" Then
intHour3 = ((DateDiff("d", DateStart, DateEnd)) + 1) * 5400
End If

End If

BetweenHoursInSecond = strHours - intHour3

End Function



Your help will be appraised

Nilses

 

[simongallop]

Not very good at debugging but try this (it seems to work!)

Dim DayStart As Date
Dim LunchStart As Date
Dim LunchEnd As Date
Dim DayEnd As Date
Dim WholeDay As Integer
Dim StartTime As Date
Dim EndTime As Date
Dim WorkedTime As Date
Dim DaySecs As Double
Dim TimeSecs As Integer

Function TimeWorkedSeconds(StartDate As Date, EndDate As Date) As Double
'DECLARE TIMES
DayStart = "09:00:00"
LunchStart = "12:00:00"
LunchEnd = "13:30:00"
DayEnd = "17:30:00"

'WORK OUT WHOLE DAYS
WholeDay = Int(EndDate - StartDate)


'WORK OUT REMAINDER OF TIME
'START BY LIMITING TO BEGINNING AND END OF WORKING DAY AND ALTER WholeDay ACCORDINGLY
If Format(StartDate, "hh:mm:ss") < DayStart Then
StartTime = Format(DayStart, "hh:mm:ss")
ElseIf Format(StartDate, "hh:mm:ss") > DayEnd Then
StartTime = Format(DayStart, "hh:mm:ss")
WholeDay = WholeDay - 1
Else
StartTime = Format(StartDate, "hh:mm:ss")
End If

If Format(EndDate, "hh:mm:ss") < DayStart Then
EndTime = Format(DayEnd, "hh:mm:ss")
WholeDay = WholeDay - 1
ElseIf Format(EndDate, "hh:mm:ss") > DayEnd Then
EndTime = Format(DayEnd, "hh:mm:ss")
Else
EndTime = Format(EndDate, "hh:mm:ss")
End If

'FOR START TIME BEFORE END TIME
If StartTime < EndTime Then
If StartTime < LunchStart Then
If EndTime < LunchStart Then
WorkedTime = EndTime - StartTime
ElseIf EndTime < LunchEnd Then
WorkedTime = LunchStart - StartTime
Else
WorkedTime = EndTime - StartTime + LunchStart - LunchEnd
End If
ElseIf StartTime < LunchEnd Then
If EndTime < LunchEnd Then
WorkedTime = 0
Else
WorkedTime = EndTime - LunchEnd
End If
Else
WorkedTime = EndTime - StartTime
End If
ElseIf StartTime = EndTime Then
WorkedTime = 0
Else
If StartTime < LunchStart Then
WorkedTime = DayEnd - StartTime + LunchStart - LunchEnd + EndTime - DayStart
ElseIf StartTime < LunchEnd Then
If EndTime < LunchStart Then
WorkedTime = DayEnd - LunchEnd + EndTime - DayStart
Else
WorkedTime = DayEnd - LunchEnd + LunchStart - DayStart
End If
Else
If EndTime < LunchStart Then
WorkedTime = DayEnd - StartTime + EndTime - DayStart
ElseIf EndTime < LunchEnd Then
WorkedTime = DayEnd - StartTime + LunchStart - DayStart
Else
WorkedTime = DayEnd - StartTime + EndTime - LunchEnd + LunchStart - DayStart
End If
End If
End If

'TIME WORKED!!
DaySecs = (DayEnd - LunchEnd + LunchStart - DayStart) * 86400 * WholeDay
TimeSecs = WorkedTime * 86400
TimeWorkedSeconds = DaySecs + TimeSecs

End Function

HTH

 

[simongallop]

If any one is using this code please note that the 5th line in the function needs to be changed from:

WholeDay = Int(EndDate - StartDate)

to

WholeDay = Int(EndDate) - Int(StartDate)

HTH

Harry