VBA Formula to calculate Hours Worked

Question

I'm still getting the hang of more complex formulas in VBA.

I'm wanting to create a system that can calculate the worked hours for a certain projects. For example, say my shift hours are 6AM-330PM. I start a project at 7AM on 11/14 and end it at 9AM on 11/16.

How would I go about making calculations so that the returned value will be the hours I worked while on the clock, and not a rolling 24-hour calculation? (While also skipping weekends if possible?)

Thanks!! Heres the code that Im trying to use....

Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As Integer
Dim StDate As Date
Dim StDateD As Date
Dim StDateT As Date
Dim EnDate As Date
Dim EnDateD As Date
Dim EnDateT As Date
Dim WorkDay1Start As Date
Dim WorkDay1end As Date
Dim WorkDay2Start As Date
Dim WorkDay2end As Date
Dim Result As Integer
Dim MinDay As Integer

StDate = CDate(dteStart)
EnDate = CDate(dteEnd)

WorkDay1Start = DateValue(StDate) + TimeValue("08:00:00")
WorkDay1end = DateValue(StDate) + TimeValue("17:00:00")
WorkDay2Start = DateValue(EnDate) + TimeValue("08:00:00")
WorkDay2end = DateValue(EnDate) + TimeValue("17:00:00")

If (StDate > WorkDay1end) Then
    StDate = DateAdd("d", 1, WorkDay1Start)
End If
If (StDate < WorkDay1Start) Then
    StDate = WorkDay1Start
End If

If (EnDate > WorkDay2end) Then
    EnDate = DateAdd("d", 1, WorkDay2Start)
End If
If (EnDate < WorkDay2Start) Then
    EnDate = WorkDay2Start
End If

StDateD = CDate(Format(StDate, "Short Date"))
EnDateD = CDate(Format(EnDate, "Short Date"))

If StDateD = EnDateD Then
  Result = DateDiff("n", StDate, EnDate, vbUseSystemDayOfWeek)
Else
    MinDay = (8 * 60) 'Number of minutes of a working day. Change this if you change the start and end times.
    
    'Extract the time from the two timestamps
    StDateT = Format(StDate, "Short Time")


    EnDateT = Format(EnDate, "Short Time")
'
        

'Calculate the minutes of the first day and the second one. Don't know what to do yet if the start is after 5pm or the end is before 8am
    Result = DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek)
    Result = Result + DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek)
    'Check if there was a break on both days or not.
    If DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) > (5 * 60) Then
        Result = Result - 60
    End If

    If DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek) > (5 * 60) Then
        Result = Result - 60
    End If
    
    'Add 1 day to start date. This is to start the loop to get all the days between both dates.
    StDateD = DateAdd("d", 1, StDateD)
    
    Do Until StDateD = EnDateD
        'If the date is not a saterday or a sunday we add one day.
        If (Weekday(StDateD) > 1) And (Weekday(StDateD) < 7) Then
            Result = Result + MinDay
            'Check for the holiday. If the date is a holiday, then we remove one day
            If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(StDateD) & "#")) Then
              Result = Result - MinDay
            End If
      End If
      StDateD = DateAdd("d", 1, StDateD)
    Loop
End If
NetWorkHours = Result

End Function

Answer 1

You can use DateDiff to calculate the difference between dates (and times). The following should get you pretty close to what you want to do:

Dim datStart As Date
Dim datEnd As Date

Dim sngShiftStart As Single
Dim sngShiftEnd As Single
Dim sngShiftDuration As Single

Dim lngMinutesWorked As Long
Dim lngOfftime As Long
Dim sngHoursWorked As Single

' Calculate shift length
sngShiftStart = 6
sngShiftEnd = 15.5
sngShiftDuration = sngShiftEnd - sngShiftStart

' Set start and end times
datStart = CDate("11/07/19 7:00")
datEnd = CDate("11/09/19 8:30")

lngMinutesWorked = DateDiff("n", datStart, datEnd)
lngOfftime = ((24 - sngShiftDuration) * 60) * (DateDiff("d", datStart, datEnd))

sngHoursWorked = (lngMinutesWorked - lngOfftime) / 60
MsgBox sngHoursWorked

This does not take into account weekends but you should be able to easily add that. You can check, using the Weekday function, if the Weekday of the Start date is smaller than the End date. In that case, subtract 2 * sngShiftDuration from sngHoursWorked. If your project lasts more than a week, you can look for that and subtract more weekends:

' Remove weekends
Dim sngWeekendHours As Single

If Weekday(datStart) > Weekday(datEnd) Then
    ' Weekend included
    sngWeekendHours = (2 * sngShiftDuration) * (DateDiff("w", datStart, datEnd) + 1)
End If

sngHoursWorked = ((lngMinutesWorked - lngOfftime) / 60) - sngWeekendHours