[SOLVED:] Split specific hours at the start of the week

1 Attachment(s)

Split specific hours at the start of the week

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)

Code:

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

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

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

Quote:

Originally Posted by Aussiebear

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.

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.

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?

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.

2 Attachment(s)

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

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

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

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