-
I need a datediff function that takes office hours into account.
my office hours are
08:00 to 16:30 Monday to Thursday
with half an hour lunch 12:00 to 12:30
08:00 to 13:00 on Fridays (no lunch break)
The help desk people have a system of recording faults.
a Fault can be raised 24 hours per day
and Closed usually within office hours
are you still following this?
statisics need to be maintained on how long the fault was open for. A simple datediff will calclate this but we also want to take offce hours into account.
at the moment, if a fault is reported 14:00 on a Friday and closed 09:00 on Monday it is logged as 67 hours. We want this to be changed to 1 hour if you see what I mean.
-
What an excellent question!!!
I'm gonna have a crack at this, back to you soon
(They don't give me much to do here!)
-
Hmmmmm.
It sounds to me like you are only taking office hours into account. My I am misunderstanding. All the hours for the weekend was not taken into account.
Can't you just get the datediff (backwards :( ) from when the fault was closed, to the start of the office hours?
Unless off course the fault was only closed at 09:00 Tuesday morning. Then you will have to subtract the hours between 16:30 monday and 08:00 Tuesday.
But, I'm not sure if you want only office hours.
-
Me Too...
Damn good question & back to you with an faster solution... ;)
-
Yeah... I'm the first!
Hi Mark Sreeves, here is my solution,
Code:
Option Explicit
Public Sub Main()
Dim SDT$
Dim EDT$
Dim FT(1) As String
Dim TFHr As Double 'Total fault time 0Seconds)
Dim TOFHr As Double 'Total off office time (seconds)
Dim TROFHr As Double 'Total rebat Off Office time (Seconds)
Dim xCnt%
SDT = "09/06/2000 14:00:00"
EDT = "12/06/2000 09:00:00"
'Note:
'The Off Office Hour Betweem each day is:
'Sun - Mon = 16Hr
'Mon - Tue = 16Hr
'Tue - Wed = 16Hr
'Wed - Thu = 16Hr
'Thu - Fri = 19Hr
'Fri - Sat = 24Hr
'Sat - Sun = 24Hr
'All the calculation is base on Second.
'Step 1
'Calculate the total fault time
TFHr = DateDiff("s", SDT, EDT)
'Step 2
'Calculate the Total Off Office Hour.
FT(0) = DateValue(SDT)
FT(1) = DateValue(EDT)
TOFHr = 0
While FT(0) <= FT(1)
Select Case Weekday(FT(0))
Case 1, 7 'Sun & Sat
TOFHr = TOFHr + 24
Case 2, 3, 4, 5 'Mon, Tue, Wed & Thu
TOFHr = TOFHr + 16
Case 6 'Fri
TOFHr = TOFHr + 19
End Select
FT(0) = DateValue(DateValue(FT(0)) + 1)
Wend
'Convert into seconds
TOFHr = TOFHr * 3600
'Restore the original value
FT(0) = SDT
FT(1) = EDT
'Step 3
'Calculate the Rebat Off Office time
TROFHr = 0
For xCnt = 0 To 1
Select Case Weekday(FT(xCnt))
Case 1, 7 'Sun & Sat
TROFHr = TROFHr + 24
Case 2, 3, 4, 5 'Mon, Tue, Wed & Thu
If TimeValue(FT(xCnt)) < TimeValue("8:00:00") Then
TROFHr = TROFHr + Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 8:00:00"))
ElseIf (TimeValue(FT(xCnt)) >= TimeValue("8:00:00")) And (TimeValue(FT(xCnt)) <= TimeValue("16:30:00")) Then
TROFHr = TROFHr + 28800
ElseIf TimeValue(FT(xCnt)) > TimeValue("13:00:00") Then
TROFHr = TROFHr + 28800 + Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 16:30:00"))
End If
Case 6 'Fri
If TimeValue(FT(xCnt)) < TimeValue("8:00:00") Then
TROFHr = TROFHr + Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 8:00:00"))
ElseIf (TimeValue(FT(xCnt)) >= TimeValue("8:00:00")) And (TimeValue(FT(xCnt)) <= TimeValue("13:00:00")) Then
TROFHr = TROFHr + 28800
ElseIf TimeValue(FT(xCnt)) > TimeValue("13:00:00") Then
TROFHr = TROFHr + 28800 + Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 13:00:00"))
End If
End Select
Next
'Step 4
'Recalculate the Total fault time
TFHr = Abs(TFHr - (TOFHr - TROFHr))
'Step 5
'Conversion
Debug.Print "Total Fault time is " & Format(TFHr \ 3600, "00") & ":" & Format(((TFHr - ((TFHr \ 3600) * 3600)) \ 60), "00") & ":" & Format(TFHr Mod 60, "00")
End Sub
[Edited by Chris on 06-09-2000 at 10:59 PM]
-
Second place !
i haven't spent the last two hours on this for nothing so I might as well share it.
Code:
Private Sub Form_Load()
Dim intTotal As Integer
Dim intDays As Integer
Dim intCount As Integer
Dim intHours(1 To 7) As Integer
Dim strStart As String
Dim strEnd As String
' Setup the number of hours per day
intHours(Monday) = 8
intHours(Tuesday) = 8
intHours(Wednesday) = 8
intHours(Thursday) = 8
intHours(Friday) = 5
intHours(Saturday) = 0
intHours(Sunday) = 0
' Some dummy dates for testing
strStart = "12/6/00 13:00"
strEnd = "19/6/00 09:00"
' find out how many days there are between
intDays = DateDiff("D", strStart, strEnd)
' Calculate the number of hours on the start date
intTotal = START_HOUR + intHours(WeekDay(CDate(strStart), vbMonday)) - Hour(CDate(strStart))
' if the call is logged after office hours then
' set the total to 0
If (intTotal < 0) Then
intTotal = 0
' if the call is logged before office hours then
' set the total to max hours for that day
ElseIf (intTotal > intHours(WeekDay(CDate(strStart), vbMonday))) Then
intTotal = intHours(intHours(WeekDay(CDate(strStart), vbMonday)))
End If
' If there are no days between then we have our answer
If intDays = 0 Then
txtDifference = intTotal
Exit Sub
End If
' If there's more than one day then go though totalling the hours
If intDays > 1 Then
For intCount = 1 To intDays - 1
intTotal = intTotal + intHours(WeekDay(DateAdd("D", intCount, CDate(strStart)), vbMonday))
Next
End If
' Calculate the number of hours on the last day
intTotal = intTotal + (Hour(CDate(strEnd)) - START_HOUR)
MsgBox intTotal & " Hours", , "Total"
End Sub
-
First of al , ithe thread should have said:
Very Tricky One
I missed of the Y
anyway,
I did some "black-box" testing on both lots of code and,
this is thye output from Chris's:
Start Time: 12/06/2000 07:00:00
End Time: 12/06/2000 09:00:00
Total Fault time is 05:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 08:00:00
End Time: 12/06/2000 09:00:00
Total Fault time is 01:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 06:00:00
End Time: 12/06/2000 09:00:00
Total Fault time is 03:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Hmm... not quite right
and Paul Warren
Start Time: 12/06/2000 08:00:00
End Time: 13/06/2000 10:00:00
10 Hours Total
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 09:00:00
End Time: 13/06/2000 10:00:00
9 Hours Total
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 06:00:00
End Time: 13/06/2000 10:00:00
12 Hours Total <- ought to be 10 still
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
this one isn't right either!
Anyway, Thanks for your contributions I've neally cracked it using my own method now but you keep trying if you want!
-
Hi! Mark Sreeves, I just found out, I've made a mistake in my Step 3 calculation and I've amended and redo the test and the result just show below:
Code:
Public Sub Main()
Dim SDT$
Dim EDT$
Dim FT(1) As String
Dim TFHr As Double 'Total fault time 0Seconds)
Dim TOFHr As Double 'Total off office time (seconds)
Dim TROFHr As Double 'Total rebat Off Office time (Seconds)
Dim xCnt%
'Start Time: 12/06/2000 07:00:00
'End Time: 12/06/2000 09:00:00
SDT = "12/06/2000 06:00:00"
EDT = "13/06/2000 10:00:00"
'Note:
'The Off Office Hour Betweem each day is:
'Sun - Mon = 16Hr
'Mon - Tue = 16Hr
'Tue - Wed = 16Hr
'Wed - Thu = 16Hr
'Thu - Fri = 19Hr
'Fri - Sat = 24Hr
'Sat - Sun = 24Hr
'All the calculation is base on Second.
'Step 1
'Calculate the total fault time
TFHr = DateDiff("s", SDT, EDT)
'Step 2
'Calculate the Total Off Office Hour.
FT(0) = DateValue(SDT)
FT(1) = DateValue(EDT)
TOFHr = 0
While FT(0) <= FT(1)
Select Case Weekday(FT(0))
Case 1, 7 'Sun & Sat
TOFHr = TOFHr + 24
Case 2, 3, 4, 5 'Mon, Tue, Wed & Thu
TOFHr = TOFHr + 16
Case 6 'Fri
TOFHr = TOFHr + 19
End Select
FT(0) = DateValue(DateValue(FT(0)) + 1)
Wend
'Convert into seconds
TOFHr = TOFHr * 3600
'Restore the original value
FT(0) = SDT
FT(1) = EDT
'Step 3
'Calculate the Rebat Off Office time
TROFHr = 0
For xCnt = 0 To 1
Select Case Weekday(FT(xCnt))
Case 1, 7 'Sun & Sat
TROFHr = TROFHr + 24
Case 2, 3, 4, 5 'Mon, Tue, Wed & Thu
If TimeValue(FT(xCnt)) < TimeValue("8:00:00") Then
TROFHr = TROFHr + (28800 - Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 8:00:00")))
ElseIf (TimeValue(FT(xCnt)) >= TimeValue("8:00:00")) And (TimeValue(FT(xCnt)) <= TimeValue("16:30:00")) Then
TROFHr = TROFHr + 28800
ElseIf TimeValue(FT(xCnt)) > TimeValue("13:00:00") Then
TROFHr = TROFHr + 28800 + Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 16:30:00"))
End If
Case 6 'Fri
If TimeValue(FT(xCnt)) < TimeValue("8:00:00") Then
TROFHr = TROFHr + (28800 - Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 8:00:00")))
ElseIf (TimeValue(FT(xCnt)) >= TimeValue("8:00:00")) And (TimeValue(FT(xCnt)) <= TimeValue("13:00:00")) Then
TROFHr = TROFHr + 28800
ElseIf TimeValue(FT(xCnt)) > TimeValue("13:00:00") Then
TROFHr = TROFHr + 28800 + Abs(DateDiff("s", FT(xCnt), Mid(FT(xCnt), 1, 10) & " 13:00:00"))
End If
End Select
Next
'Step 4
'Recalculate the Total fault time
TFHr = Abs(TFHr - (TOFHr - TROFHr))
'Step 5
'Conversion
Debug.Print "Start Time: " & SDT
Debug.Print "End Time : " & EDT
Debug.Print "Total Fault time is " & Format(TFHr \ 3600, "00") & ":" & Format(((TFHr - ((TFHr \ 3600) * 3600)) \ 60), "00") & ":" & Format(TFHr Mod 60, "00")
Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
End Sub
Results
Start Time: 09/06/2000 14:00:00
End Time : 12/06/2000 09:00:00
Total Fault time is 01:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 07:00:00
End Time : 12/06/2000 09:00:00
Total Fault time is 01:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 08:00:00
End Time : 12/06/2000 09:00:00
Total Fault time is 01:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 06:00:00
End Time : 12/06/2000 09:00:00
Total Fault time is 01:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 08:00:00
End Time : 13/06/2000 10:00:00
Total Fault time is 10:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 09:00:00
End Time : 13/06/2000 10:00:00
Total Fault time is 09:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Start Time: 12/06/2000 06:00:00
End Time : 13/06/2000 10:00:00
Total Fault time is 10:00:00
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
V Strange
When I run my code and put in the dates you've used it works fine and gives the result of 10 hours for the last one. What on earth is that all about ?
-
Definitely works
I've tweked it a bit for easier testing so give it a go and let me know if it doesn't work. I would be very interested to know if you still get the 12 hour result :
Code:
Option Explicit
Dim intHours(1 To 7) As Integer
Private Const START_HOUR As Integer = 8
Public Sub Main()
Dim strStart As String
Dim strEnd As String
Dim intCount As Integer
' Setup the number of hours per day
intHours(1) = 8 ' Monday
intHours(2) = 8 ' Tuesday
intHours(3) = 8 ' etc...
intHours(4) = 8
intHours(5) = 5
intHours(6) = 0 ' Saturday
intHours(7) = 0 ' Sunday
For intCount = 1 To 5
strStart = InputBox("Enter start :", "Start", "12/06/2000 06:00:00")
strEnd = InputBox("Enter end :", "End", "13/06/2000 10:00:00")
Calc_Hours strStart, strEnd
Next intCount
End Sub
Private Sub Calc_Hours(strStart As String, strEnd As String)
Dim intTotal As Integer
Dim intDays As Integer
Dim intCount As Integer
Dim txtDifference As String
' Find out how many days there are between
intDays = DateDiff("D", strStart, strEnd)
' Calculate the number of hours on the start date
intTotal = START_HOUR + intHours(WeekDay(CDate(strStart), vbMonday)) - Hour(CDate(strStart))
' if the call is logged after office hours then
' set the total to 0
If (intTotal < 0) Then
intTotal = 0
' if the call is logged before office hours then
' set the total to max hours for that day
ElseIf (intTotal > intHours(WeekDay(CDate(strStart), vbMonday))) Then
intTotal = intHours(WeekDay(CDate(strStart), vbMonday))
End If
' If there are no days between then we have our answer
If intDays = 0 Then
txtDifference = intTotal
Exit Sub
End If
' If there's more than one day then go though totalling the hours
If intDays > 1 Then
For intCount = 1 To intDays - 1
intTotal = intTotal + intHours(WeekDay(DateAdd("D", intCount, CDate(strStart)), vbMonday))
Next
End If
' Calculate the number of hours on the last day
intTotal = intTotal + (Hour(CDate(strEnd)) - START_HOUR)
MsgBox intTotal & " Hours", , "Total"
End Sub
-
I've completed my own version now!
I'll have a look at both your versions a bit later because I've got to work on somthing urgent now! :(
My own version very pretty complicated but totally configurable.
it expresses the "raw" time and days as an array of bytes.
So to set a lunch-break I just have to clear a BIT.
I then do a bitwise AND on raw time with each day an then count the set bits.
So far each day is an array of 6 bytes which gives the times to the closest half hour. I'll probably expand upon this to give the closest quarter of an hour because that will be close enough for what I need.
