Cannot think of a short title, see whole post please :)

[Lux Aeterna]

I've made an excel sheet that automatically adds working hours (arrival - departure) and overtime hours for every month.

What I'd like to do is to add overtime up to 20 hours per month in total.

In the picture below there are 22 working days, so I'd like to have a maximum of 20 days of 1 hour overtime, not 22 as it is now (yellow box).

Moreover, there are months that someone might work, for example, for 15 days. So a possible solution would be 10 days of 1 hour overtime and 5 days of 2 hours overtime.

Finally, someone might have worked for 8 days. In that case I'd like to have 2 hours overtime daily.

Max overtime per day is 2 hours, and max overtime per month is 20 hours.

Hope it's not too complicated, thank toy in advance.

PS: Wherever you see 15:00, it's the sum of the cell on the left (14:00) plus 1:00. I can add the excel file if necessary

 

[Lux Aeterna]

@sijpie I talked with my colleagues today. We agreed to use the last formula you posted, so you don't need to bother writing another macro! You've been really helpful and I appreciate it a lot!

 

[sijpie]

Ok, I'll modify the code for B8. I know that it isn't always 1st day of the month. That isn't a problem

 

[Lux Aeterna]

The following should do it. The formula's are fairly complicated but it works...

Formula's:
B5: =IFERROR(IF(C4-B4,MIN(2,IF(C4*24<22,22-C4*24)),0),0)
D5: ==IFERROR(IF(E4-D4,MIN(2,IF(E4*24<22,22-E4*24)),0),0)
Copy D5 to F5, H5 and J5
L5: =SUM(B5:K5)

B6: =IF(B5,IF(C4<22/24,C4,"-"),"-")
C6: =IF(B5,B6+B5/24,"-")
Copy B6:C6 to all other overtime cells (green cells)

B11: =IFERROR(IF(C10-B10,IF($L5<20,MIN(2,20-$L5,IF(C10*24<22,22-C10*24)),0),0),0)
D11: =IFERROR(IF(E10-D10,MIN(2,MAX(0,20-SUM($B11:C11,$L5)),IF(E10*24<22,22-E10*24)),0),0)
Copy D11 to F11, H11 and J11
L11: =SUM(B5:K5,L5)
Copy B11:L11 to rows 17, 23 & 29

View attachment 56652

I was talking about this formula. No need to bother with the macro at all ?

 

[sijpie]

Understood. However for completeness sake, I have modified the code to deal with any starting cell. In the comments read the comment starting with <<<< and modify the cell address in that row.
The code will then work.

It will add the correct amount of overtime and, once 20 hrs overtime has been reached, even out the overtime to maximise the number of 1 hr overtime

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' This macro runs on any value change made to worksheet
    'It assumes teh top left cell 'Monday' is cell B8 - see comment below
    
    Dim rTotOT As Range, rTopLeft As Range
    Dim iTot As Integer, iR As Integer, iC As Integer, iRC As Integer, iCC As Integer, _
        UB1 As Integer, UB2 As Integer, iDepHr As Integer, iCurOT As Integer, iROffs As Integer, iCOffs As Integer
    Dim vMonth As Variant
    Dim bDepTime As Boolean
    Dim colOT1hr As Collection, colOT2hr As Collection
    Dim vDate As Variant
    
    'if more than 1 cell changed (copy paste for instance) then exit
    If Target.Cells.Count > 1 Then Exit Sub
    
    Set rTopLeft = Range("B8")  '<<<<< Change this if the top left (Monday) cel is not B8
    iROffs = rTopLeft.Row: iCOffs = rTopLeft.Column
    
    ' check if relevant cell has changed. The cell changed is called 'Target'
    ' Check if changes made to the arrival or departure times
    If Not Intersect(Target, Union(Range(Cells(iROffs + 2, iCOffs), Cells(iROffs + 2, iCOffs + 9)), _
                                    Range(Cells(iROffs + 8, iCOffs), Cells(iROffs + 8, iCOffs + 9)), _
                                    Range(Cells(iROffs + 14, iCOffs), Cells(iROffs + 14, iCOffs + 9)), _
                                    Range(Cells(iROffs + 20, iCOffs), Cells(iROffs + 20, iCOffs + 9)), _
                                    Range(Cells(iROffs + 26, iCOffs), Cells(iROffs + 26, iCOffs + 9)))) Is Nothing Then
        ' is arrival or departure time changed?
        bDepTime = Target.Column Mod 2      'if bDepTime = True, then it is a departure time that was changed, else an arrival time
        ' only act on changes when both start and departure time are given
        If (bDepTime And Target < Target.Offset(0, -1)) Or (Not bDepTime And Target > Target.Offset(0, 1)) Then
        ' if OT exists, but deptime < arr time, then clear OT
            If bDepTime Then
                Target.Offset(1, -1) = 0
            Else
                Target.Offset(1, 0) = 0
            End If
            Exit Sub
        End If
        
        If (bDepTime And Target > Target.Offset(0, -1)) Or (Not bDepTime And Target < Target.Offset(0, 1)) Then
            'initiate two collections to keep score of 1hr and 2 hour overtime allocations
            Set colOT1hr = New Collection: Set colOT2hr = New Collection
            'Read the month into array
            vMonth = Range(Cells(iROffs, iCOffs), Cells(iROffs + 28, iCOffs + 9)).Value
            iROffs = iROffs - 1: iCOffs = iCOffs - 1  '    offset between array and sheet is iCOffs columns and iROffs rows
            UB1 = UBound(vMonth, 1): UB2 = UBound(vMonth, 2)
            iRC = Target.Row - iROffs: iCC = Target.Column - iCOffs
            ' get total OT already assigned
            For iR = 4 To UB1 Step 6
                For iC = 1 To UB2 Step 2
                    Select Case vMonth(iR, iC)
                        Case 1
                            colOT1hr.Add iR & "," & iC
                        Case 2
                            colOT2hr.Add iR & "," & iC
                        Case Else   'do nothing
                    End Select
                Next iC
            Next iR
            'total overtime allocated
            iTot = colOT1hr.Count + colOT2hr.Count * 2
            
            'store any current OT in modified day
            iCurOT = IIf(bDepTime, vMonth(iRC + 1, iCC - 1), vMonth(iRC + 1, iCC))
            'check if dep < 22:00
            If bDepTime Then
                iDepHr = CInt(vMonth(iRC, iCC) * 24)
            Else
                iDepHr = CInt(vMonth(iRC, iCC + 1) * 24)
            End If
            'now see what OT needs to be added
            iTot = iTot - iCurOT  '(-current ot as this may be a change of arrival or departure time)
            Select Case iTot
                Case Is <= 18
                    Select Case iDepHr
                        Case Is >= 22
                            ' too late to claim OT
                        Case 21
                            ' One hour possible
                            'add 1 hr OT to date's OT line
                            If bDepTime Then
                                Target.Offset(1, -1) = 1
                            Else
                                Target.Offset(1, 0) = 1
                            End If
                        Case Else
                            ' Two hours possible
                            'add 2 hr OT to date's OT line
                            If bDepTime Then
                                Target.Offset(1, -1) = 2
                            Else
                                Target.Offset(1, 0) = 2
                            End If
                    End Select
                Case 19
                    Select Case iDepHr
                        Case Is >= 22
                            ' too late to claim OT
                        Case Else
                            ' One hour possible
                            'add 1 hr OT to date's OT line
                            If bDepTime Then
                                Target.Offset(1, -1) = 1
                            Else
                                Target.Offset(1, 0) = 1
                            End If
                    End Select
                Case 20
                    Select Case iDepHr
                        Case Is >= 22
                            ' too late to claim OT
                        Case Else
                            ' One hour possible but need to decrease any 2hr OT
                            If colOT2hr.Count > 0 Then
                                'adjust 1st 2 hr OT to 1 hr
                                vDate = Split(colOT2hr(1), ",")
                                Cells(vDate(0) + iROffs, vDate(1) + iCOffs) = 1
                                'add 1 hr OT to date's OT line
                                If bDepTime Then
                                    Target.Offset(1, -1) = 1
                                Else
                                    Target.Offset(1, 0) = 1
                                End If
                            Else
                                ' no OT available, all already as 1 hr
                                If bDepTime Then
                                    Target.Offset(1, -1) = 0
                                Else
                                    Target.Offset(1, 0) = 0
                                End If
                            End If
                    End Select
            End Select
        End If
    End If
End Sub