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.