If you work from 20:15 to 02:30 on a Saturday, how many hours are in the interval 15:30 to 00:00, and what should you be paid? The function HoursInInterval() can give you the answer and calculate your wage correct depending on it’s a weekday, weekend or a holiday.

You can download the workbook at the bottom of this article.

Example formulas

=@HoursInInterval($D3;$E3;16;18;$C3;MonThu)-IF(H3="x";Lunch;0)
  • You will find this formula in cell I3 in sheet “Hour Registration”.
  • $D3 is when you startet work. This parameter is mandatory.
  • $E3 is when you stopped work. This parameter is mandatory.
  • 16 is the start of the time interval we compare the worked time with. Optional parameter.
  • 18 if the end of the time interval we compare the worked time with. Optional parameter.
  • $C3 is the date. Optional parameter. Required for the Holiday handling to kick in.
  • MonTue is the day code. If sent as a parameter, the day of the week must match with this code. You find the day codes in the sheet “Holidays”. Optional parameter. If omitted the function will calculate the hours regardless of type of day.

The last part -IF(H3=”x”;Lunch;0) subtracts the lunch time if H3 is “x”

Function HoursInInterval code

Function HoursInInterval(dFrom As Double, dTo As Double, Optional IntervalStart As Double, Optional IntervalStop As Double, Optional dDate As Date, Optional DayNum As Integer)
    
    Dim x As Long
    Dim FromTime As Double
    Dim ToTime As Double
    Dim dStart As Double
    Dim dStop As Double
    Dim Min As Long
    Dim iDay As Integer
    Dim OverMid As Boolean
    Dim Modus As Integer
 
    'Find weekday number
    If dDate <> "00:00:00" Then
        iDay = Weekday(dDate, vbMonday)
    End If
 
    'Is this a holiday?
    If IsHoliDay(dDate) = True Then
        iDay = 10
    End If
  
    'Find minute value between dFrom and dTo
    FromTime = Hour(dFrom) * 60 + Minute(dFrom)
    ToTime = Hour(dTo) * 60 + Minute(dTo)
 
    'If no time, exit with zero
    If FromTime = 0 And ToTime = 0 Then
        HoursInInterval = 0
        Exit Function
    End If
 
    'Find time interval
    dStart = IntervalStart * 60
    dStop = IntervalStop * 60
 
    'Increase with 24 hours if dStop < dStart
    If dStop < dStart Then
        dStop = dStop + 24 * 60
    End If
 
    'Increase with 24 hours if Totime <= Fromtime
    If ToTime <= FromTime Then
        ToTime = ToTime + 24 * 60
    End If
 
    'Check if ouside interval
    'If interval ends before FromTime, exit with zero
    If dStop < FromTime And dStop <> 0 Then
        HoursInInterval = 0
        Exit Function
    End If
 
    'The six situations
 
    If dStop = 0 And dStart = 0 Then
        Modus = 1
    ElseIf ToTime <= dStart Then
        Modus = 6
    ElseIf FromTime <= dStart And ToTime <= dStop Then
        Modus = 2
    ElseIf FromTime <= dStart And ToTime > dStop Then
        Modus = 3
    ElseIf FromTime > dStart And ToTime <= dStop Then
        Modus = 4
    ElseIf FromTime > dStart And ToTime > dStop Then
        Modus = 5
    End If
   
  
    'Modus=1 - no interval check
    If Modus = 1 Then
        Min = ToTime - FromTime
    End If
  
    'Modus=2 FromTime<=StartTime and Totime<=dStop
    If Modus = 2 Then
        Min = ToTime - dStart
    End If
  
    'Modus=3 FromTime<=dStart og ToTime>dStop
    If Modus = 3 Then
        Min = dStop - dStart
    End If
 
    'Modus=4 FromTime>dStart and ToTime<=sStop
    If Modus = 4 Then
        Min = ToTime - FromTime
    End If
 
    'Modus=5 FromTime>dStart og ToTime>dStop
    If Modus = 5 Then
        Min = dStop - FromTime
    End If
 
    'ToTime < dStart in interval
    If Modus = 6 Then
        Min = 0
    End If

    'If weekday is sent as parameter, iDay must be være lik iDay / hverdag / helg
    If DayNum <> 0 Then
  
        'Monday to Thursday
        If DayNum = 11 Then
            If iDay > 4 Then
                Min = 0
            End If
        End If
  
        'Weekday
        If DayNum = 8 Then
            If iDay > 5 Then
                Min = 0
            End If
        End If
  
        'Weekend
        If DayNum = 9 Then
            If iDay < 6 Then
                Min = 0
            End If
        End If
  
        'If given weekday or holiday, the day must match
        If DayNum < 8 Or DayNum = 10 Then
            If iDay <> DayNum Then Min = 0
        End If

    End If
 
 
    HoursInInterval = Min / 60
 
End Function

Function IsHoliDay(dDate As Date)
    Dim x As Integer
    Dim Stopp As Boolean
    Dim sString As String
    Dim FormattedDate As String
    Static err As Boolean
    
    On Error GoTo ErrMsg
 
    Dim Found As Long
 
    Found = fR(shHolidays, "Date", Format(dDate, "yyyy-mm-dd"), True)
 
    If Found <> 0 Then
        IsHoliDay = True
    Else
        IsHoliDay = False
    End If
 
    Exit Function
 
ErrMsg:

    If err = False Then
        err = True
        MsgBox ("Doesn't work. Check that the sheet Holidays exists")
    
    End If
    
End Function

Public Function EasterDate(Yr As Integer) As Date

    Dim x As Integer
    x = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
    EasterDate = DateSerial(Yr, 3, 1) + x + (x > 48) + 6 - ((Yr + Yr \ 4 + x + (x > 48) + 1) Mod 7)
    
End Function

Download the workbook: Hour registration (1034 downloads )

Similar Posts