# Time calculations including networkdays and specific hours

#### MZalews88

##### New Member
Hello All!

This is my 1st post here. After looong brainstorming I decided to try forums with my issue...
I need to create a formula in VBA which would substract dates (that is easy part).

But...there are few contidions:
1) I need to include only working days (worksheetfunction.networkdays)
2) I need to remember, that every full day is 8.50 hours long
3) 1st day finishes at 5:00:00 PM
4) last day starts at 8:30:00 AM

What I need to is to count the total time of an order from when it is in the system until it's completed, there're few steps:
1) count worksheetfunction.networkdays, substract 2 (1st and last day)
2) count number of hours for 1st day for example: 5:00:00 PM - 1/23/2019 10:38:51 AM(this is the format in file)
3) count number of hours for last day for exampl: 1/30/2019 12:59:32 PM - 8:30:00
4) summarise 1st day hours + last day hours + full days hours (8.5 hour per day as mentioned).

This is what I was trying to do...it works if there're no integers, for example 34 hours or so, but in case of 8.5 hour I'm struggling to add it, to the sum of the 1st and last day...any help would be much appreciated.

Code(it's not finished, I afraid not even in half):

Function TotalHours(Start As Date, EndT As Date)
Dim FirstDay, LastDay As Long

NetworkD = WorksheetFunction.NetworkDays(Start, EndT) - 2
FullDays = NetworkD * 8.5

If (TimeValue(Start) > TimeValue("5:00:00 PM")) Then StartDiff = 0 Else StartDiff = TimeValue("5:00:00 PM") - TimeValue(Start)

'MsgBox Hour(StartDiff) & ":" & Minute(StartDiff) & ":" & Second(StartDiff)

If (TimeValue("8:30:00 AM") < TimeValue(EndT)) Then EndDiff = 0 Else EndDiff = TimeValue(EndT) - TimeValue("8:30:00 AM")

'MsgBox Hour(EndDiff) & ":" & Minute(EndDiff) & ":" & Second(EndDiff)

Select Case NetworkD

Case Is >= 2

FirstAndLast = Left(Format(Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff), "HH:MM:SS"), 2)

Total = FullDays + FirstAndLast & ":" & Mid(Format(Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff), "HH:MM:SS"), 4, 2) _
& ":" & Right(Format(Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff), "HH:MM:SS"), 2)

TotalHours = Total

Case Is = 1

'FirstAndLast = Left(Format(Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff), "HH:MM:SS"), 2)

'Total = FullDays + FirstAndLast & ":" & Mid(Format(Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff), "HH:MM:SS"), 4, 2) _
& ":" & Right(Format(Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff), "HH:MM:SS"), 2)

'TotalHours = Total

'MsgBox Hour(StartDiff + EndDiff) & ":" & Minute(StartDiff + EndDiff) & ":" & Second(StartDiff + EndDiff)
'MsgBox TimeSerial(8, 30, 0)
'MsgBox TimeValue(FullDays)

Case Else

TotalHours = ""

End Select

End Function

### Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the \$ sign).

#### RSpin

##### New Member
If I understand correctly, then I think this might do it for you

Code:
``````Function TotalHours(Start As Date, EndT As Date) As Double

Dim SingleDay As Integer
Dim HoursWorked As Double

HoursWorked = 0
For SingleDay = 0 To DateDiff("d", Start, EndT)
If Weekday(DateAdd("d", SingleDay, Start), vbUseSystemDayOfWeek) <> 1 And Weekday(DateAdd("d", SingleDay, Start), vbUseSystemDayOfWeek) <> 7 Then
If SingleDay = 0 Then
If TimeValue(Start) < TimeValue("5:00:00 PM") Then
If TimeValue(Start) < TimeValue("8:30:00 AM") Then
HoursWorked = HoursWorked + 8.5
Else
HoursWorked = HoursWorked + (TimeValue("5:00:00 PM") - TimeValue(Start))
End If
End If
Else
If SingleDay = DateDiff("d", Start, EndT) Then
If TimeValue(EndT) > TimeValue("8:30:00 AM") Then
If TimeValue(EndT) > TimeValue("5:00:00 PM") Then
HoursWorked = HoursWorked + 8.5
Else
HoursWorked = HoursWorked + (TimeValue("5:00:00 PM") - TimeValue(EndT))
End If
End If
Else
HoursWorked = HoursWorked + 8.5
End If
End If
End If
Next SingleDay
TotalHours = HoursWorked

End Function``````

#### MZalews88

##### New Member
Hi RSpin!

Thanks for your answer To be honest...I tried 2nd approach yday and I came up with the following code (it works!)

Function TotalHours(Start As Date, EndT As Date)

Dim Networkd As Long
Dim FirstDaySeconds, LastDaySeconds, SameDaySeconds, FullDays, Hours, Hours0, FirstTest As Double
Dim WS_Holiday As Worksheet
Dim R_Holiday As Range
Dim FirstDayHours, LastDayHours, SameDayHours As Date

Set WS_Holiday = Worksheets("Holiday")

'if you wish to add any holiday to the sheet, please remember to update the range
Set R_Holiday = WS_Holiday.Range("A2:A32")

'networkdays function to include only working days
Networkd = WorksheetFunction.NetworkDays(Start, EndT, R_Holiday) - 2

Select Case Networkd

Case Is >= 1
'in case of 1st day we measure time from when order came in until 5 pm, if order enters after 5pm we put 0
'in case of last day we measure tim from 8:30 am until order is completed
FullDays = Networkd * 8.5 * 3600
If (TimeValue(Start) >= TimeValue(#5:00:00 PM#)) Then FirstDayHours = 0 Else FirstDayHours = TimeValue(#5:00:00 PM#) - TimeValue(Start)

FirstDaySeconds = Hour(FirstDayHours) * 3600 + Minute(FirstDayHours) * 60 + Second(FirstDayHours)

LastDayHours = TimeValue(EndT) - TimeValue(#8:30:00 AM#)
LastDaySeconds = Hour(LastDayHours) * 3600 + Minute(LastDayHours) * 60 + Second(LastDayHours)

Hours = (FirstDaySeconds + LastDaySeconds + FullDays) / 86400

TotalHours = Application.WorksheetFunction.Text(Hours, "[h]:mm:ss")

Case Is = 0

FullDays = 0

If (TimeValue(Start) >= TimeValue(#5:00:00 PM#)) Then FirstDayHours = 0 Else FirstDayHours = TimeValue(#5:00:00 PM#) - TimeValue(Start)

FirstDaySeconds = Hour(FirstDayHours) * 3600 + Minute(FirstDayHours) * 60 + Second(FirstDayHours)

LastDayHours = TimeValue(EndT) - TimeValue(#8:30:00 AM#)
LastDaySeconds = Hour(LastDayHours) * 3600 + Minute(LastDayHours) * 60 + Second(LastDayHours)

Hours = (FirstDaySeconds + LastDaySeconds + FullDays) / 86400

TotalHours = Application.WorksheetFunction.Text(Hours, "[h]:mm:ss")

Case Is <= -1

SameDayHours = TimeValue(EndT) - TimeValue(Start)

SameDaySeconds = Hour(SameDayHours) * 3600 + Minute(SameDayHours) * 60 + Second(SameDayHours)

Hours0 = SameDaySeconds / 86400

TotalHours = Application.WorksheetFunction.Text(Hours0, "[h]:mm:ss")

End Select

Cheers!
Michal

#### RSpin

##### New Member
I'm glad it all worked out for you.

Replies
3
Views
52
Replies
2
Views
51
Replies
0
Views
143
Replies
26
Views
1K
Replies
1
Views
78