From String to numeric

  • 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 a forum 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 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
 
Hi Bob:

There are 2 parts to this answer:

1) Use the DateDiff function-

DateDiff("s", [Time1], [Time2])

will give you seconds elapsed; "n" will return minutes ("m" is already used
for months!).

2) Once you have the seconds elapsed, you can convert it to time by the
following equation-

TimeVariable = Int(Seconds / 3600) & ":" & Format(Int(((Seconds / 3600) -
(Int(Seconds / 3600))) * 60), "00") & ":" & Format(CInt(((Seconds /
60) - (Int(Seconds / 60))) * 60), "00")

Regards,
Al
 
Addendum/Problem: The problem dealt with workdays!

Here is the workaround- you gotta put in step 3 (tip obtained from board
years ago)-

Workdays Between 2 Dates

The function below calculates workdays between two dates. Copy and paste it
into an Access module in the database you're using.



Function CountWorkdays (StartDate As Variant, EndDate As Variant) As Integer

'Calculates the number of work days between two dates i.e. excludes days
which fall on a weekend.

'Does not take public holidays into account

'Parameters: StartDate (The beginning date entered between hash marks i.e.
#1/1/98#)

'EndDate (The finishing date between which to count work days

'Returns: A count of week days

'How to use: Paste the following code into an Access module. Then use it
throughout Access using

'the following syntax:

'=CountWorkDays(#18/5/98#, #24/5/98#)

'OR without the = sign



Dim intCount As Integer

Dim varLoop As Variant



On Error GoTo Err_CountWorkDays



'initialize count

intCount = 0

For varLoop = StartDate + 1 To EndDate

If (Weekday(varLoop) <> 1 And Weekday(varLoop) <> 7) Then

intCount = intCount + 1

End If

Next

CountWorkdays = intCount + 1



Exit_Err_CountWorkDays:

Exit Function



Err_CountWorkDays:

If Err = 94 Then 'Invalid Use of Null. No date parameters supplied

'Don't show error MsgBox

Resume Exit_Err_CountWorkDays

Else

MsgBox Error$

Resume Exit_Err_CountWorkDays

End If

End Function

Regards,
AL

Al Borges said:
Hi Bob:

There are 2 parts to this answer:

1) Use the DateDiff function-

DateDiff("s", [Time1], [Time2])

will give you seconds elapsed; "n" will return minutes ("m" is already used
for months!).

2) Once you have the seconds elapsed, you can convert it to time by the
following equation-

TimeVariable = Int(Seconds / 3600) & ":" & Format(Int(((Seconds / 3600) -
(Int(Seconds / 3600))) * 60), "00") & ":" & Format(CInt(((Seconds /
60) - (Int(Seconds / 60))) * 60), "00")

Regards,
Al

Box 666 said:
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 a forum 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 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
Click to expand...
Click to expand...
 
Back
Top