Consulting

Results 1 to 10 of 10

Thread: Split specific hours at the start of the week

  1. #1

    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)

    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
    Attached Files Attached Files
    Last edited by thor1124; 05-26-2024 at 01:39 AM.

  2. #2
    snb
    Guest
    Avoid merged cells.
    Study: dynamic tables in Excel
    Follow an Excel course.

  3. #3
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,180
    Location
    Welcome VBAX thor1124. Pay no attention to snb's input., as its both rude and condesending. We appreciate you posting here.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  4. #4
    Quote Originally Posted by Aussiebear View Post
    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.

  5. #5
    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.

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    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?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    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.

  8. #8
    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
    Attached Images Attached Images
    Attached Files Attached Files

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

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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •