VBA Macro or formula to calculate regular hours and overtime

[Chief Ace]

Good evening Excel Ninja's,

Kindly requesting assistant to calculate the following either by VBA macros or formula. What i am trying to do is to calculate the hours of work from time in to time out but first the 8 hours of regular must be met before employee can be credited overtime. Please see sample file. I even try using the below macro to no avail it doesn't separate the overtime to another column once the 8 hours of regular has been met. Thank you in advance for any assist.

>>> use code - tags <<<

Sub CalculateHours()
    Dim StartTime As Date
    Dim EndTime As Date
    Dim RegularHours As Double
    Dim OvertimeHours As Double
  
    For Each cell In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
        StartTime = cell.Value
        EndTime = cell.Offset(0, 1).Value
        If IsDate(StartTime) And IsDate(EndTime) Then
            If EndTime < StartTime Then
                EndTime = EndTime + 1
            End If
            RegularHours = (EndTime - StartTime) * 24
            If RegularHours >= 8 Then
                OvertimeHours = RegularHours - 8
                RegularHours = 8
            Else
                OvertimeHours = 0
            End If
            cell.Offset(0, 2).Value = RegularHours
            cell.Offset(0, 3).Value = OvertimeHours
            If OvertimeHours > 0 Then
                cell.Offset(0, 3).Value = OvertimeHours
                cell.Offset(0, 2).Value = 8
            End If
        End If
    Next cell
End Sub

 

[Marc L]

Hello, first according to forum rules you must edit your initial post​

in order to use the code tags via the Code option from the 3 dots menu …​

And add the necessary explanation for how to calculate - with details / samples - in order there is nothing to guess !​

​

 

[Chief Ace]

Hello, My apology.

Revised file attached. I tried running the macro and the result all came out under the regular column. What i am trying to do is when the first 8 hours of regular work is met then the rest of hours worked beyond 8 hours will be overtime. Attached is a file sample and have and end result desired. Thank you.

 

[rlv01]

Hello, My apology.

Revised file attached. I tried running the macro and the result all came out under the regular column. What i am trying to do is when the first 8 hours of regular work is met then the rest of hours worked beyond 8 hours will be overtime. Attached is a file sample and have and end result desired. Thank you.

I think the reason that the results all came out in the regular column is because your data samples are all less that 8 hours:



If I add a few more hours to make sure there is some overtime to report, and then run your exact code (no mods by me), the numbers seem reasonable



What am I missing?

 

[Chief Ace]

I think the reason that the results all came out in the regular column is because your data samples are all less that 8 hours:
View attachment 83612


If I add a few more hours to make sure there is some overtime to report, and then run your exact code (no mods by me), the numbers seem reasonable
View attachment 83613


What am I missing?

Yes you are correct, but work hours are random so if you add the 2.92 hours and then the next work is 6.25 you add this two together it will total 9.17 hours since this over 8 hours the 1.17 hours should have gone to overtime column. Now for the rest of the working hours of the employee of 4.75 and another 4 hours should be in the overtime column. I hope this clears it up. Like i mentioned in the sample file the outcome result is there. Thank you.

On another note if VBA cannot do it, can it be done in formula?

 

[rlv01]

VBA can do it, it just was not clear to me what you were after.

 

[Chief Ace]

VBA can do it, it just was not clear to me what you were after.

Yes that is the result i wanted. I greatly appreciated your time and effort. Have a blessed day.

 

[Chief Ace]

Hi rlv01,

I apologized in advanced, just found out after i showed the work that you have done to my manager that it works and now the manager said that there's a multiple dates that should be calculated to. Is there a way to modify the code to reflect the same thing for the other dates? I attached the file with new info. Again sorry for not being cleared. Thank you.

 

[rlv01]

Sub CalculateHours()
    Dim EndTime As Date, StartTime As Date, LastDay As Date
    Dim OvertimeHours As Double, RegularHours As Double, TH As Double, TotalHours As Double
    Dim Cell As Range, CellRange As Range

    Set CellRange = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    For Each Cell In CellRange
        If Cell.Offset(0, -1).Value <> LastDay Then
            LastDay = Cell.Offset(0, -1).Value
            TotalHours = 0
        End If
        StartTime = Cell.Value
        EndTime = Cell.Offset(0, 1).Value
        If IsDate(StartTime) And IsDate(EndTime) Then
            If EndTime < StartTime Then
                EndTime = EndTime + 1
            End If

            TH = (EndTime - StartTime) * 24
            TotalHours = TotalHours + TH
            RegularHours = TH
            If TotalHours >= 8 Then
                OvertimeHours = TotalHours - 8
                RegularHours = Application.Max(RegularHours - OvertimeHours, 0)
            Else
                OvertimeHours = 0
            End If
            Cell.Offset(0, 2).Value = RegularHours
            If RegularHours > 0 Then
                Cell.Offset(0, 3).Value = OvertimeHours
            Else
                Cell.Offset(0, 3).Value = TH
            End If
        End If
    Next Cell
End Sub

 

[Chief Ace]

Sub CalculateHours()
    Dim EndTime As Date, StartTime As Date, LastDay As Date
    Dim OvertimeHours As Double, RegularHours As Double, TH As Double, TotalHours As Double
    Dim Cell As Range, CellRange As Range

    Set CellRange = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    For Each Cell In CellRange
        If Cell.Offset(0, -1).Value <> LastDay Then
            LastDay = Cell.Offset(0, -1).Value
            TotalHours = 0
        End If
        StartTime = Cell.Value
        EndTime = Cell.Offset(0, 1).Value
        If IsDate(StartTime) And IsDate(EndTime) Then
            If EndTime < StartTime Then
                EndTime = EndTime + 1
            End If

            TH = (EndTime - StartTime) * 24
            TotalHours = TotalHours + TH
            RegularHours = TH
            If TotalHours >= 8 Then
                OvertimeHours = TotalHours - 8
                RegularHours = Application.Max(RegularHours - OvertimeHours, 0)
            Else
                OvertimeHours = 0
            End If
            Cell.Offset(0, 2).Value = RegularHours
            If RegularHours > 0 Then
                Cell.Offset(0, 3).Value = OvertimeHours
            Else
                Cell.Offset(0, 3).Value = TH
            End If
        End If
    Next Cell
End Sub

Thank you for the revise code rlv01. I greatly appreciate the help and a quick response that you have provided. Have a blessed day. Regards.