Calculate working hours

[ErikJan]

This is an old one, I know and I have looked around but there doesn't appears to be a one-size-fits-all piece of code (which I'd be willing to share / created based on input I might get here).

So the inputs are:
* Start time (date and time)
* End time (date and time)
* # hrs in a working day (typ 8)
* Start of workday (e.g. 08:00)
* End of workday (e.g. 17:30)
* Non-working time in workday (e.g. 12:00 - 12:30)
* Weekend days (e.g. Sat & Sun)
* List of holidays

Output is number of work hours.

I use this for Excel so the data could be read in a flexible way from an Excel sheet

[jstevens]

ErikJan,

You may want to distinguish between hourly and salaried team members. Do hourly employees get paid for lunch? If not you'll need account with separate in/out calculations for time worked. Have you considered accounting for PTO plans?

[ErikJan]

Thanks John. What I described will serve my needs but people are free to add features to any code we'll get and/or develop.
I guess the lunch thing I mentioned was a little too much probably (it's 30 mins only); I could live without that feature... ;-)

[HansV]

How would the Start of Workday and End of Workday affect the calculation?

[ErikJan]

If the start date is Monday 16:00h and the end date is Wednesday 09:00h, the calculation is
1 hr for Monday (because e.g. end of workday is 17:00)
8 hr for Tuesday (because e.g. start of workday is 09:00 and end of workday is 17:00)
1 hr for Wednesday (because e.g. start of workday is 08:00)

Total: 10 working hours (I already forgot about lunch; and assumed there were not interfering holidays)

[HansV]

So # hrs in a working day is no longer relevant?

[ErikJan]

Yes, sorry, you are right

[HansV]

The following is probably not the most efficient code possible; it is intended for use in Excel only.

Code: Select all

Function WorkingHours(StartDT As Date, EndDT As Date, StartWD As Date, _
        EndWD As Date, WeekendDays As String, Holidays) As Double
    Dim h
    Dim d1 As Date
    Dim t1 As Date
    Dim d2 As Date
    Dim t2 As Date
    Dim w As Long
    Dim f As Boolean
    Dim wh As Date
    d1 = Int(StartDT)
    t1 = StartDT - d1
    If t1 < StartWD Then t1 = StartWD
    Do
        w = Weekday(d1, vbMonday)
        f = (Mid(WeekendDays, w, 1) = "1")
        For Each h In Holidays
            If d1 = h Then
                f = True
                Exit For
            End If
        Next h
        If Not f Then Exit Do
        d1 = d1 + 1
        t1 = StartWD
    Loop
    d2 = Int(EndDT)
    t2 = EndDT - d2
    If t2 > EndWD Then t2 = EndWD
    Do
        w = Weekday(d2, vbMonday)
        f = (Mid(WeekendDays, w, 1) = "1")
        For Each h In Holidays
            If d2 = h Then
                f = True
                Exit For
            End If
        Next h
        If Not f Then Exit Do
        d2 = d2 - 1
        t2 = EndWD
    Loop
    wh = EndWD - StartWD
    WorkingHours = Round(24 * (wh * (Application.NetworkDays_Intl(d1, d2, WeekendDays, Holidays) - 1) + _
        (t2 - t1)), 2)
End Function

Example of use:

Code: Select all

Sub Test()
    Dim t As Double
    t = WorkingHours(#1/1/2020 11:00:00 AM#, #1/20/2020 1:00:00 PM#, #9:00:00 AM#, #5:00:00 PM#, _
        "0000011", Range("Holidays"))
    MsgBox t
End Sub

Holidays is a named range containing public holidays. The code doesn't take forced absence due to Coronavirus into account.

[HansV]

The WeekendDays argument is a 7-character string consisting of 0s and 1s. 0 = working day, 1 = weekend day, counting from Monday to Sunday. So for example "0000011" means that Saturday and Sunday are the weekend days. This is the same as in the NETWORKDAYS.INTL worksheet function.

[ErikJan]

Works, thanks. I was OK to try this myself as well but wanted to check out what was available first.

I couldn't have done it as elegantly as you did Hans. Thanks!