UDF To Calculate Work hours between two dates Problem with code

[jlclyde]

Here is my code.
Function WkgHrs(StartTime As Date, EndTime As Date) As Single
'This function calculates the number of working hours between
'two date-time values. Working hours are defined as Mon - Thurs,
'0430 - 2399.99 and Friday 0430-1030 hours. Fractions of hours are
'included in the calculations.
Dim Hstart As Variant 'Starting hour array
Dim Hend As Variant 'Ending hour array
Dim DOW As Integer 'Day of week (1=Sunday, 2=Monday, 3=Tuesday, etc.)
Dim DOWstart As Integer
Dim DOWend As Integer
Dim D As Date
Dim DeltaH As Single 'Hours to be subtracted
Dim Tend As Single
Dim Tstart As Single

Hstart = Array(0, 0, 4.5, 4.5, 4.5, 4.5, 4.5, 0)
Hend = Array(0, 0, 23.99999, 23.99999, 23.99999, 23.99999, 10.5, 0)

If EndTime - StartTime < 1 And Int(StartTime) <> Int(EndTime) Then
WkgHrs = 19.5
Else
WkgHrs = 0
End If

'First sum hour for whole days
For D = StartTime To EndTime
DOW = Weekday(D)
WkgHrs = WkgHrs + Hend(DOW) - Hstart(DOW)
Next D

'Now subtract time for partial days
DOW = Weekday(StartTime) '4:30 AM
Tstart = 24 * (StartTime - Int(StartTime))
If Tstart > Hstart(DOW) And Hstart(DOW) <> 0 Then
WkgHrs = WkgHrs - (Tstart - Hstart(DOW))
End If

DOW = Weekday(EndTime)
Tend = 24 * (EndTime - Int(EndTime))
If Tend < Hend(DOW) And Hend(DOW) <> 24 Then
WkgHrs = WkgHrs - (Hend(DOW) - Tend)
End If

End Function

Here is my problem. I have two dates; 8/9/2007 17:37 and 8/10/2007
9:35. I thought, according to my code that this woudl produce a
result of 11.46 hours. The result that it is producing is 24.97. Can
anyone help me with this?
Thanks,
Jay

 

[Niek Otten]

< I thought, according to my code that this woudl produce a result of 11.46 hours>

Why?


--
Kind regards,

Niek Otten
Microsoft MVP - Excel

| Here is my code.
| Function WkgHrs(StartTime As Date, EndTime As Date) As Single
| 'This function calculates the number of working hours between
| 'two date-time values. Working hours are defined as Mon - Thurs,
| '0430 - 2399.99 and Friday 0430-1030 hours. Fractions of hours are
| 'included in the calculations.
| Dim Hstart As Variant 'Starting hour array
| Dim Hend As Variant 'Ending hour array
| Dim DOW As Integer 'Day of week (1=Sunday, 2=Monday, 3=Tuesday, etc.)
| Dim DOWstart As Integer
| Dim DOWend As Integer
| Dim D As Date
| Dim DeltaH As Single 'Hours to be subtracted
| Dim Tend As Single
| Dim Tstart As Single
|
| Hstart = Array(0, 0, 4.5, 4.5, 4.5, 4.5, 4.5, 0)
| Hend = Array(0, 0, 23.99999, 23.99999, 23.99999, 23.99999, 10.5, 0)
|
| If EndTime - StartTime < 1 And Int(StartTime) <> Int(EndTime) Then
| WkgHrs = 19.5
| Else
| WkgHrs = 0
| End If
|
| 'First sum hour for whole days
| For D = StartTime To EndTime
| DOW = Weekday(D)
| WkgHrs = WkgHrs + Hend(DOW) - Hstart(DOW)
| Next D
|
| 'Now subtract time for partial days
| DOW = Weekday(StartTime) '4:30 AM
| Tstart = 24 * (StartTime - Int(StartTime))
| If Tstart > Hstart(DOW) And Hstart(DOW) <> 0 Then
| WkgHrs = WkgHrs - (Tstart - Hstart(DOW))
| End If
|
| DOW = Weekday(EndTime)
| Tend = 24 * (EndTime - Int(EndTime))
| If Tend < Hend(DOW) And Hend(DOW) <> 24 Then
| WkgHrs = WkgHrs - (Hend(DOW) - Tend)
| End If
|
| End Function
|
| Here is my problem. I have two dates; 8/9/2007 17:37 and 8/10/2007
| 9:35. I thought, according to my code that this woudl produce a
| result of 11.46 hours. The result that it is producing is 24.97. Can
| anyone help me with this?
| Thanks,
| Jay
|

 

[Toppers]

try:

Function WkgHrs(StartTime As Date, EndTime As Date) As Single
'This function calculates the number of working hours between
'two date-time values. Working hours are defined as Mon - Thurs,
'0430 - 2399.99 and Friday 0430-1030 hours. Fractions of hours are
'included in the calculations.
Dim Hstart As Variant 'Starting hour array
Dim Hend As Variant 'Ending hour array
Dim DOW As Integer 'Day of week (1=Sunday, 2=Monday, 3=Tuesday, etc.)
Dim DOWstart As Integer
Dim DOWend As Integer
Dim D As Date
Dim DeltaH As Single 'Hours to be subtracted
Dim Tend As Single
Dim Tstart As Single

Hstart = Array(0, 0, 4.5, 4.5, 4.5, 4.5, 4.5, 0)
Hend = Array(0, 0, 23.99999, 23.99999, 23.99999, 23.99999, 10.5, 0)


'First sum hour for whole days
For D = Int(StartTime) To Int(EndTime)
DOW = Weekday(D)
WkgHrs = WkgHrs + Hend(DOW) - Hstart(DOW)
Next D

'Now subtract time for partial days
DOW = Weekday(StartTime) '4:30 AM
Tstart = 24 * (StartTime - Int(StartTime))
If Tstart > Hstart(DOW) And Hstart(DOW) <> 0 Then
WkgHrs = WkgHrs - (Tstart - Hstart(DOW))
End If

DOW = Weekday(EndTime)
Tend = 24 * (EndTime - Int(EndTime))
If Tend < Hend(DOW) And Hend(DOW) <> 24 Then
WkgHrs = WkgHrs - (Hend(DOW) - Tend)
End If

End Function

 

[jlclyde]

try:

That worked awesome! All of my numbers are coming out correctly. The
differene that I see is a change by taking out the IF statments that I
have in relation to wkghrs.

Thank you!
Jay

 

[Rick Rothstein \(MVP - VB\)]

The first time 8/9/2007 17:37 is 6 hours 23 minutes away from midnight. The
second time 8/10/2007 9:35 is 9 hours 35 minutes after midnight BUT the
first 4.5 hours of it are not work hours; so, only 5 hours 5 minutes of the
difference is work hours. Add the two up 6:23 + 5:05 equals 11 hours 28
minutes which is 11.46667 hours.

Rick