Split specific hours at the start of the week

[thor1124]

Dear all,

I am trying to write an excel vba to calculate the overtime hours of our staff during every week of a month but my coding fails to calculate the hours correctly in some scenarios. (case 3 in sample data)

Target: the overtime period starts from Monday to Sunday every week and the first 4 hours claimed by our staff will be calculated by normal rate while the remaining hours will be calculated by extra rate.



File: Sample Data is under sheet "Sample Data" and the expected result is under sheet "Result".

Coding is as follows (multiple IF statements to check whether the 1st 4 hours have been splitted to calculate the hours at normal rate and I suspect that the coding fails to cater for some scenarios)

For Each WS In wb.Worksheets
    Select Case WS.Name
        Case "Officer_List", "Sheet1"
        Case Else
            For i = wb.Sheets(WS.Name).Range("A1").End(xlDown).Row To wb.Sheets(WS.Name).Range("A1048576").End(xlUp).Row
                If IsEmpty(wb.Sheets(WS.Name).Range("A" & i)) Then
                    GoTo next_row:
                End If
                For j = wb.Sheets(WS.Name).Range("A1").End(xlToRight).Column To wb.Sheets(WS.Name).Range("XFD1").End(xlToLeft).Column
                    If Not IsEmpty(wb.Sheets(WS.Name).Cells(1, j)) Then
                        Src_DataRow = wb.Sheets(WS.Name).Range("A" & i)
                        Set Srh_DataRow = wb.Sheets(OT_Data).Range("C1:C1048576").Find(what:=Src_DataRow, LookIn:=xlValues, lookat:=xlWhole)
                        If Srh_DataRow Is Nothing Then
                            MsgBox " New Employee ID " & Src_DataRow & " with OT hours Found"
                            Exit Sub
                        End If
                        Src_DataCol = wb.Sheets(WS.Name).Cells(1, j)
                        Set Srh_DataCol = wb.Sheets(OT_Data).Range("L18:AP18").Find(what:=Src_DataCol, LookIn:=xlValues, lookat:=xlWhole)
                        If Srh_DataCol Is Nothing Then
                            MsgBox " New Month Date " & Src_DataCol & " with OT hours Found"
                            Exit Sub
                        End If
                        If wb.Sheets(WS.Name).Cells(i, j).Value = 0 Or wb.Sheets(WS.Name).Cells(i, j).Value = "" Then
                            wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value = wb.Sheets(WS.Name).Cells(i, j).Value
                            Accumulated_OT = Accumulated_OT + wb.Sheets(WS.Name).Cells(i, j).Value
                            If Weekday(Src_DataCol, vbMonday) = 7 Then
                                Accumulated_OT = 0
                            End If
                        ElseIf wb.Sheets(WS.Name).Cells(i, j).Value >= 4 And Accumulated_OT = 4 Then
                            wb.Sheets("OT_44_Upload_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value = 0
                            wb.Sheets("OT_44_Upload_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Offset(1, 0).Value = wb.Sheets(WS.Name).Cells(i, j).Value
                            If Weekday(Src_DataCol, vbMonday) = 7 Then
                                Accumulated_OT = 0
                            End If
                        ElseIf wb.Sheets(WS.Name).Cells(i, j).Value >= 4 And Accumulated_OT < 4 Then
                            wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value = 4 - Accumulated_OT
                            wb.Sheets("OT__Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Offset(1, 0).Value = _
                            wb.Sheets(WS.Name).Cells(i, j).Value - wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value
                            Accumulated_OT = Accumulated_OT + wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value
                            If Weekday(Src_DataCol, vbMonday) = 7 Then
                                Accumulated_OT_44 = 0
                            End If
                        ElseIf wb.Sheets(WS.Name).Cells(i, j).Value >= 0.01 And wb.Sheets(WS.Name).Cells(i, j).Value < 4 And Accumulated_OT = 4 Then
                            wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value = 0
                            wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Offset(1, 0).Value = wb.Sheets(WS.Name).Cells(i, j).Value
                            If Weekday(Src_DataCol, vbMonday) = 7 Then
                                Accumulated_OT = 0
                            End If
                        ElseIf wb.Sheets(WS.Name).Cells(i, j).Value >= 0.01 And wb.Sheets(WS.Name).Cells(i, j).Value < 4 Then
                            wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value = wb.Sheets(WS.Name).Cells(i, j).Value
                            Accumulated_OT = Accumulated_OT + wb.Sheets("OT_Data").Cells(Srh_DataRow.Row, Srh_DataCol.Column).Value
                            If Weekday(Src_DataCol, vbMonday) = 7 Then
                                Accumulated_OT = 0
                            End If
                        Else: MsgBox "Check!"
                    End IF
                End If
            Next j
        next_row:
    Next i
End Select

[snb]

Avoid merged cells.
Study: dynamic tables in Excel
Follow an Excel course.

[Aussiebear]

Welcome VBAX thor1124. Pay no attention to snb's input., as its both rude and condesending. We appreciate you posting here.

[thor1124]

Welcome VBAX thor1124. Pay no attention to snb's input., as its both rude and condesending. We appreciate you posting here.

Thank you for your reply and this is my first time posting here after get stuck for a while.

[thor1124]

Sorry I cannot edit my 1st post so I have added some example here:

Example 1: 9 Overtime hours on 1-Apr-2024

1st 4 Overtime hours on 1-Apr-2024 will be calculated at normal rate

Remaining 5 Overtime hours on 1-Apr-2024 will be calculated at extra rate

Any Overtime hours performed from 2-Apr-2024 to 7-Apr-2024 will be calculated at extra rate since the overtime cutoff period starts from Monday to Sunday

Example 2: 1 Overtime hours on 1-Apr-2024, 2 Overtime hours on 2-Apr-2024, 1 Overtime hours on 5-Apr-2024, 10 Overtime hours on 7-Apr-2024

1st 4 Overtime hours will be calculated at normal rate, that means normal rate on 1, 2, 5-Apr-2024

Remaining 10 Overtime hours on 7-Apr-2024 will be calculated at extra rate

the overtime cutoff period starts from Monday to Sunday. That means the 1st 4 overtime hours rule at normal rate rule will apply on next overtime cutoff period from 8-Apr-2024 to 14-Apr-2024.

Then the final overtime result will be placed in sheet "Result" under normal and extra rate respectively for every week of the month.

Thank you for your help.

[Paul_Hossler]

It seems that your 'work week' is Mon-Sun and in your example April 1st just happens to be a Monday

However, May 1st is a Wednesday and May 31st is a Friday, so what do you do with May 1 - 5?

Way back when I had to work for a living, our work weeks were Sun-Sat, but the fiscal month was from the first Sunday in the month to the Saturday before the first Sunday in the next month, or May 5 to June 1

Do you really want to always use the calendar month?

[thor1124]

Thanks for your reply, Paul. Sorry that I didn't make myself clear on the post. Our work weeks always start from Monday to Sunday regardless of the calendar month. For example, the work weeks start from 29-Apr-2024 to 5-May-2025 and it involves the work day for Apr and May 2024. A guy who has performed overtime for 8 hours on 29-Apr-2024 will then have 4 hours calculated at normal rate and then extra rate for the remaining 4 hours. Any more overtime hours he performed from 30-Apr-2024 to 5-May-2024 will be calculated at extra rate. If he only have 2 overtime hours on 29-Apr-2024 and then performed 10 hours on 5-May-2024, then 2 overtime hours on 5-May-2024 will be calculated at normal rate and the remaining 8 hours on 5-May-2024 will be calculated at extra rate. Currently, the source file that I received was on monthly-basis so I have to check the previous overtime hours of last month to see whether the first 4 overtimes hours have already calculated at normal rate.

In the meantime, I am getting stuck on my VBA as it doesn't work on splitting the first 4 hours of the week on a calendar month. I guess I will try to tackle the issue of the work week if it involves 2 calendar month next.

Thank you for reading.

[jdelano]

I was able to get the result you are looking for with this code:

Private Sub btnCalculate_Click()


    ' total the overtime hours for each employee by week
    ' the week resets on Monday
    ' initial 4 hours are calculated at normal OT pay
    ' any hours over that are calculated at the extra rate
    
    Dim sampleDataWorksheet As Worksheet
    Dim sampleDataDateRow As Integer
    Dim sampleDataStartRow As Integer
    Dim sampleDataStartCol As Integer
    Dim sampleDataKey As String
    Dim sampleDataLastRow As Long
    Dim sampleDataRow As Long
    Dim sampleDataCol As Integer
    Dim sampleDataHours As Integer
    
    Dim resultWorkSheet As Worksheet
    Dim resultKeyRange As Range
    Dim resultKeyMatched As Range
    Dim resultDateCol As Integer
    
    Dim totalWeekOTHours As Integer
    Dim previousTotalWeekOTHours As Integer
    Dim remainingHoursToFillNormalRate As Integer
    Dim overtimeHoursDate As Date
    
    ' assign each sheet to a variable
    Set resultWorkSheet = ThisWorkbook.Sheets("Result")
    
    ' assign the area in the result sheet to search for matching key
    Set resultKeyRange = resultWorkSheet.Range("A5:A9")
    
    
    Set sampleDataWorksheet = ThisWorkbook.Sheets("Sample Data")
    
    ' what is the last row with an employee and their hours
    sampleDataLastRow = sampleDataWorksheet.Cells(sampleDataWorksheet.Rows.Count, "A").End(xlUp).Row
    
    sampleDataStartRow = 6 ' what row to start looping rows
    sampleDataStartCol = 3 ' where do the hours start
    
    sampleDataDateRow = 1  ' which row has the date


    ' loop through the rows containing employee and hours
    For sampleDataRow = sampleDataStartRow To sampleDataLastRow
        sampleDataKey = sampleDataWorksheet.Cells(sampleDataRow, 1).Value
        
        ' find the key on the result sheet
        Set resultKeyMatched = resultKeyRange.Find(sampleDataKey, LookIn:=xlValues)
        If Not resultKeyMatched Is Nothing Then
            ' the key was matched - caclulate the hours
            
            ' loop through the columns to caclulate the OT delination
            totalWeekOTHours = 0
            For sampleDataCol = sampleDataStartCol To sampleDataStartCol + 30
                
                ' hitting a blank date column jumps out of the column for/next loop
                If Len(sampleDataWorksheet.Cells(sampleDataDateRow, sampleDataCol).Value) = 0 Then Exit For
                
                ' get the date for this column
                'overtimeHoursDate = sampleDataWorksheet.Cells(sampleDataDateRow, sampleDataCol).Value
                
                ' **********
                ' I have to change the format of the date for my region - uncomment the line above for yours and delete or comment this out
                ' ************************
                overtimeHoursDate = CDate(Mid(sampleDataWorksheet.Cells(sampleDataDateRow, sampleDataCol).Value, 4, 2) & _
                    "/" & Left(sampleDataWorksheet.Cells(sampleDataDateRow, sampleDataCol).Value, 2) & "/" & _
                    Right(sampleDataWorksheet.Cells(sampleDataDateRow, sampleDataCol).Value, 4))
                
                sampleDataHours = Val(sampleDataWorksheet.Cells(sampleDataRow, sampleDataCol).Value)
                totalWeekOTHours = totalWeekOTHours + sampleDataHours
                
                resultDateCol = sampleDataCol + 2 ' the format of result sheet has the data column in E where sample starts in C
                If totalWeekOTHours < 5 Then
                    ' the upper limit of normal rate hours hasn't been reached, only write the hours if there are some
                    If sampleDataHours > 0 Then resultWorkSheet.Cells(resultKeyMatched.Row, resultDateCol).Value = sampleDataHours
                Else
                    If previousTotalWeekOTHours < 4 Then
                        ' place the amount that fills the 4 hours in the normal range row
                        
                        ' how many of this days hours should be used to satisfy the normal rate total
                        remainingHoursToFillNormalRate = 4 - previousTotalWeekOTHours
                        resultWorkSheet.Cells(resultKeyMatched.Row, resultDateCol).Value = remainingHoursToFillNormalRate
                        
                        ' take the remainder of this days hours and place them in the extra rate area
                        resultWorkSheet.Cells(resultKeyMatched.Row, resultDateCol).Offset(1, 0).Value = sampleDataHours - remainingHoursToFillNormalRate
                    Else
                        ' just put this day's hours on the extra rate row
                        If sampleDataHours > 0 Then resultWorkSheet.Cells(resultKeyMatched.Row, resultDateCol).Offset(1, 0).Value = sampleDataHours
                    End If
                    
                End If
                
                If Weekday(overtimeHoursDate) = vbSunday Then
                    ' the next day will be Monday, reset the total vars
                    totalWeekOTHours = 0
                    previousTotalWeekOTHours = 0
                Else
                    previousTotalWeekOTHours = totalWeekOTHours   ' keep track of the total house after
                End If
                
            Next sampleDataCol
        Else
            ' the key was not found on the result sheet - indicate that it wasn't processed
            ' by coloring the cell red
            sampleDataWorksheet.Cells(sampleDataRow, 1).Interior.Color = vbRed
        End If
    
    Next sampleDataRow
    
End Sub

[thor1124]

Hello jdelano. Thank you so much for your effort and this is exactly the code that I am looking for. Thanks again.

[jdelano]

You're very welcome, happy to lend a hand.