Anne,
Attached is the module, I am a novice and certainly not a programmer.
The module will produce a list of hours elapsed (in working days) in the
format of days/hours/mins/secs between 2 dates. However once I have the list
of results I cannot do anything with it. I need to be able to to find
smallest, largest and avg.
Whilst this is a claculated field, I have tried adding it to a table and
then sorting etc but it still will not work. Any suggestions as to how to
resolve this situation greatfully received.
Bob
Function WorkingHours(ByVal SDate As Date, ByVal EDate As
Date) As String
Const SDay As Integer = 9 '9am start
Const EDay As Integer = 17 '5pm 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\8) & ":"
& Format$(lngHours MOD 08,"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