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 (1186 downloads )