Start and end times

[Box 666]

I need to calculate the length of time an item is outstanding, as we have an
agreement to respond to all items within 2 working hours. (so my answer must
be in days and hours and mins)(Defenition of a working day Mon - Fri 9 to
5.)

I have found a module which will do this (copy below) howerever it does not
allow for weekends. I have found a second module that will return the number
of working days between two dates.(copy below) but it will only give an
answer in "days"

I am not a programmer, could somebody advise me how or if I can combine
these two modules into one that will provide the time outstanding between a
start and end date - ignoring weekends.

Alternatively does anyone have a module that will do exactly as required.?
with thanks

Bob
Public Function ElapsedTimeString(dateTimeStart As Date, dateTimeEnd As
Date) As String
'*********************************************************************
' Function ElapsedTimeString(dateTimeStart As Date, dateTimeEnd As Date) As
String
' Returns the time elapsed between a starting Date/Time and an ending
' Date/Time formatted as a string that looks like this:
' "10 days, 20 hours, 30 minutes, 40 seconds".
'*********************************************************************
Dim interval As Double, str As String, days As Variant
Dim hours As String, minutes As String, seconds As String
If IsNull(dateTimeStart) = True Or _
IsNull(dateTimeEnd) = True Then Exit Function

interval = dateTimeEnd - dateTimeStart

days = Fix(CSng(interval))
hours = Format(interval, "h")
minutes = Format(interval, "n")
seconds = Format(interval, "s")

' Days part of the string
str = IIf(days = 0, "", _
IIf(days = 1, days & " Day", days & " Days"))
str = str & IIf(days = 0, "", _
IIf(hours & minutes & seconds <> "000", ", ", " "))
' Hours part of the string
str = str & IIf(hours = "0", "", _
IIf(hours = "1", hours & " Hour", hours & " Hours"))
str = str & IIf(hours = "0", "", _
IIf(minutes & seconds <> "00", ", ", " "))
' Minutes part of the string
str = str & IIf(minutes = "0", "", _
IIf(minutes = "1", minutes & " Minute", minutes & " Minutes"))
str = str & IIf(minutes = "0", "", IIf(seconds <> "0", ", ", " "))
' Seconds part of the string
str = str & IIf(seconds = "0", "", _
IIf(seconds = "1", seconds & " Second", seconds & " Seconds"))
ElapsedTimeString = IIf(str = "", "0", str)
End Function



'*********** Code Start **************
Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer
' Note that this function does not account for bank holidays.
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer

BegDate = DateValue(BegDate)

EndDate = DateValue(EndDate)
WholeWeeks = DateDiff("w", BegDate, EndDate)
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
Do While DateCnt < EndDate
If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
Work_Days = WholeWeeks * 5 + EndDays
End Function
'*********** Code End **************

 

[ChrisJ]

Try this

Note: It does not know anything about public holidays!!


Function WorkingHours(ByVal SDate As Date, ByVal EDate As
Date) As String

Const SDay As Integer = 8 '8am start
Const EDay As Integer = 18 '6pm finish
Dim lngDays as Long
Dim lngHours As Long
Dim lngMins As Single
Dim lngSecs As Single
Dim lngCount As Long

WorkingHours = "0"
If DatePart("h", SDate) < SDay Then
'Start time before SDay
'Move the time to the start of the working day
SDate = CVDate(Format$(SDate, "dd mmm yyyy") & " " &
Format$(SDay, "00") & ":00:00")
End If

If DatePart("w", SDate, vbMonday) > 5 Then
'Start day not weekday
'Move it to the start hour of monday
Do
If DatePart("w", SDate, vbMonday) = 1 Then Exit Do
SDate = DateAdd("d", 1, SDate)
Loop
SDate = CVDate(Format$(SDate, "dd mmm yyyy") & " " &
Format$(SDay, "00") & ":00:00")
End If

If SDate > EDate Then
Exit Function
End If

If DatePart("Y", SDate) = DatePart("Y", EDate) Then
'Same day
If DatePart("h", EDate) < EDay Then
'Straight subtraction
WorkingHours = Format$(EDate - SDate, "hh:mm:ss")
Exit Function
Else
EDate = CVDate(Format$(SDate, "dd mmm yyyy") & " "
& CStr(EDay) & ":00:00")
WorkingHours = Format$(EDate - SDate, "hh:mm:ss")
Exit Function
End If
End If

If DatePart("w", EDate, vbMonday) > 5 Then
'Ends on a weekend
lngHours = 0 'The number of hours on the last day
lngMins = 0 'The number of minutes on the last day
lngSecs = 0 'The number of minutes on the last day
Else
'Ends on a weekday
If DatePart("h", EDate) < SDay Then
'Finished before start time
lngHours = 0 'The number of hours on the last
day
lngMins = 0 'The number of minutes on the last
day
lngSecs = 0 'The number of minutes on the last
day
Else
'Finished after start time
lngHours = DatePart("h", EDate) - SDay 'The
number of hours on the last day
lngMins = DatePart("n", EDate) 'The number of
minutes on the last day
lngSecs = DatePart("s", EDate) 'The number of
minutes on the last day
End If
End If
Do
If Int(SDate) > Int(EDate) Then
'Ooops
WorkingHours = "0"
Exit Do
End If
'Step back to start day, stepping over weekends
EDate = DateAdd("d", -1, EDate)
If DatePart("w", EDate, vbMonday) < 6 Then
'This is a weekday
If Int(SDate) = Int(EDate) Then
'We are back to the start date
'Add it to the time from the start day
EDate = CVDate(Format$(EDate, "dd mmm
yyyy") & " " & CStr(EDay) & ":00:00")
lngHours = lngHours + DatePart("h",
(EDate - SDate))
lngMins = lngMins + DatePart("n", (EDate -
SDate))
lngSecs = lngSecs + DatePart("s", (EDate -
SDate))
If lngSecs > 59 Then
lngSecs = lngSecs - 60
lngMins = lngMins + 1
End If
If lngMins > 59 Then
lngMins = lngMins - 60
lngHours = lngHours + 1
End If
WorkingHours = CSTR(int(lngHours\24) & ":"
& Format$(lngHours MOD 24,"00") & ":" &
Format$(lngMins, "00") & ":" & Format$(lngSecs, "00")
Exit Do
Else
If Int(SDate) > Int(EDate) Then
WorkingHours = "0"
Exit Do
Else
'Add in a full day
lngHours = lngHours + EDay - SDay
End If
End If
End If
Loop
End Function

 

[Box 666]

Chris,
You are magic, thanks this works perfectly.

Very minor point when the result shows on the report, if the query has
been resolved on the same day as it arrived the result shows as 03:14:52 -
if the query goes over one day the result shows as 0:03:14:52. How can I get
the 2 results to look the same.

A real big thank you again.

Bob

 

[Box 666]

Chris,

Sorry final question, once I have the result of the query i.e.
0:03:47:14 it will then not let me do any thing with it i.e. sort it
ascending -descending / find largest smallest, average time o/s etc. Do I
need to do something "different " so that I can manipulate the data.

thanks

Bob

 

[ChrisJ]

This will make them look the same.

Re sorting etc. You can sort them and find max min first
last etc. But remember you are dealing with a string, not
a number or date. So it will sort alphabetically, which is
not what you want. The only way to do what you want is to
get a numerical value in minutes (or seconds)



Function WorkingHours(ByVal SDate As Date, ByVal EDate As
Date) As String

Const SDay As Integer = 8 '8am start
Const EDay As Integer = 18 '6pm finish
Dim lngDays as Long
Dim lngHours As Long
Dim lngMins As Single
Dim lngSecs As Single
Dim lngCount As Long

WorkingHours = "0"
If DatePart("h", SDate) < SDay Then
'Start time before SDay
'Move the time to the start of the working day
SDate = CVDate(Format$(SDate, "dd mmm yyyy") & " " &
Format$(SDay, "00") & ":00:00")
End If

If DatePart("w", SDate, vbMonday) > 5 Then
'Start day not weekday
'Move it to the start hour of monday
Do
If DatePart("w", SDate, vbMonday) = 1 Then Exit Do
SDate = DateAdd("d", 1, SDate)
Loop
SDate = CVDate(Format$(SDate, "dd mmm yyyy") & " " &
Format$(SDay, "00") & ":00:00")
End If

If SDate > EDate Then
Exit Function
End If

If DatePart("Y", SDate) = DatePart("Y", EDate) Then
'Same day
If DatePart("h", EDate) < EDay Then
'Straight subtraction
WorkingHours = "0:" & Format$(EDate -
SDate, "hh:mm:ss")
Exit Function
Else
EDate = CVDate(Format$(SDate, "dd mmm yyyy") & " "
& CStr(EDay) & ":00:00")
WorkingHours = Format$(EDate - SDate, "hh:mm:ss")
Exit Function
End If
End If

If DatePart("w", EDate, vbMonday) > 5 Then
'Ends on a weekend
lngHours = 0 'The number of hours on the last day
lngMins = 0 'The number of minutes on the last day
lngSecs = 0 'The number of minutes on the last day
Else
'Ends on a weekday
If DatePart("h", EDate) < SDay Then
'Finished before start time
lngHours = 0 'The number of hours on the last
day
lngMins = 0 'The number of minutes on the last
day
lngSecs = 0 'The number of minutes on the last
day
Else
'Finished after start time
lngHours = DatePart("h", EDate) - SDay 'The
number of hours on the last day
lngMins = DatePart("n", EDate) 'The number of
minutes on the last day
lngSecs = DatePart("s", EDate) 'The number of
minutes on the last day
End If
End If
Do
If Int(SDate) > Int(EDate) Then
'Ooops
WorkingHours = "0"
Exit Do
End If
'Step back to start day, stepping over weekends
EDate = DateAdd("d", -1, EDate)
If DatePart("w", EDate, vbMonday) < 6 Then
'This is a weekday
If Int(SDate) = Int(EDate) Then
'We are back to the start date
'Add it to the time from the start day
EDate = CVDate(Format$(EDate, "dd mmm
yyyy") & " " & CStr(EDay) & ":00:00")
lngHours = lngHours + DatePart("h",
(EDate - SDate))
lngMins = lngMins + DatePart("n", (EDate -
SDate))
lngSecs = lngSecs + DatePart("s", (EDate -
SDate))
If lngSecs > 59 Then
lngSecs = lngSecs - 60
lngMins = lngMins + 1
End If
If lngMins > 59 Then
lngMins = lngMins - 60
lngHours = lngHours + 1
End If
WorkingHours = CSTR(int(lngHours\24) & ":"
& Format$(lngHours MOD 24,"00") & ":" &
Format$(lngMins, "00") & ":" & Format$(lngSecs, "00")
Exit Do
Else
If Int(SDate) > Int(EDate) Then
WorkingHours = "0"
Exit Do
Else
'Add in a full day
lngHours = lngHours + EDay - SDay
End If
End If
End If
Loop
End Function