Working days as a string

  • Thread starter Thread starter Box 666
  • Start date Start date
B

Box 666

I needed help with a piece of programing (a module) that would calculate the
number of working days/hours/ mins /secs between 2 dates(working day being
Mon - Friday from 9am to 5pm). A member of this forum very kindly provided
the following
code, which does exactly what I want and will produce an answer as
0:00:00:00. which is in a string format.
What I also need to be able to do is find longest outstanding / shortest
resolved / average time o/s etc in short manipulate the data which I cannot
do in its current format.
What is the best way to resolve this working days / time as a string issue.

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
 
I'm wondering what is wrong with using DateDiff to determine the difference
between the two dates, in seconds, and using that in comparisons?

Of course, you could convert the text string back to a numeric value for
seconds for your comparison. The Split function of Access 2000* and later
will split the text string on ":", convert to number using CInt or CLng,
multiply each part by the number of seconds in that unit of time, and then
add them. But, iff the date/time fields are still available, I'd rather use
DateDiff.

* There have been many postings of code to
split a list for previous versions, if you are
using Access 97 or earlier.

Larry Linson
Microsoft Access MVP
 
Larry,
The problem with using DateDiff is that I do not believe it makes
allowance for Sat / Sun and a reduced working day.
If I receive a job at 16:45 on a Friday and I resolve it by 09:30 on
Monday that job has been os for just 45mins ( working time - 15mins Fri +
30mins Mon) but DateDiff will tell me it has been o/s for well over 2 days.
My thoughts had been more along the lines of trying to convert back to secs
and do any manipulation on that.
You may have gathered from my question, I am not very familiar with
Access ( I know what I want it to do, but getting it to do it is usually the
problem.)
I am using Access 2000 how would you suggest I go about spliting the
string and how do I then use / apply Clng .

Bob
 
Look at Help. That's the first step. Did I not mention the Split builtin
function and the Clng builtin function were documented in Help?

The split function, with ":" specified as the separator, will split each of
the values into an entry in an array. You would then use Clng to convert
those text values to Long Integer, a numeric type that you can use in
calculations.

And, of course, if you do not record the start and end times of the actual
work, but only when the work arrives and when it is finished, you certainly
will have to make provision for weekends and daily work hours. I'm not used
to working in shops where people drop whatever they are doing when the
whistle blows on Friday evening and don't pick it up again until the whistle
blows on Monday morning. It is not a _given_, just something to be assumed,
that time is recorded the way you describe, nor that people work in that
way.

I'm sorry I just don't have time and energy to write and test the code to
take your string and turn it into a number of seconds. But, as I said, the
Help is a start. I assume you wrote some reasonable amount of code to create
that string in the first place, didn't you?

Larry Linson
Microsoft Access MVP
 
Back
Top