adding additional calculations

Hello,

i have been working on this (attached) file and i can't find a way to add some additional calculations. In "WYKONANIE" sheet, which is a work timetable i would like to have following information:

- if the break between end of work and begging of it was shorter then 11 hours and how many
- work time longer then 12 hours and how many

this is just one sheet for whole file since file bigger then 1MB


any help will be greatly appreciated

This needs a userdefined function (UDF)
Enter the following code in a module and the following in Row 16 to the right =overhours(A16:FQ16) and =underbreak(A16:FQ16)

Code:

---

Function OverHours(Data As Range)
    rw = Data.Row
    For i = 6 To 170 Step 4
        If IsNumeric(Cells(rw, i)) Then
            hrs = Cells(rw, i + 1) - Cells(rw, i)
            If hrs < 0 Then hrs = hrs + 1
            If hrs > 0.5 Then
                x = x + 1
            End If
        End If
    Next
    OverHours = x
End Function


Function UnderBreak(Data As Range)
    rw = Data.Row
    For i = 10 To 170 Step 4
        If IsNumeric(Cells(rw, i)) And IsNumeric(Cells(rw, i - 3)) _
        And Cells(rw, i) > 0 And Cells(rw, i - 3) > 0 Then
            hrs = Cells(rw, i) - Cells(rw, i - 3)
            If hrs < 0 Then hrs = hrs + 1
            If hrs > 0 And hrs < 11 / 24 Then
                x = x + 1
            End If
        End If
    Next
    UnderBreak = x
End Function

---

For testing purposes, this will check rows 16:55 on the sheet, highlight issues and return a result

Code:

---

Sub Test()    Dim rw As Long
    Cells(16, 1).Resize(40, 170).Interior.ColorIndex = xlNone
    For rw = 16 To 55
        OH = OH + xOverHours(rw)
        UB = UB + xUnderBreak(rw)
    Next rw
    MsgBox "OverHours: " & OH & vbCr & "Underbreak: " & UB
End Sub


Function xOverHours(rw As Long)
    For i = 6 To 170 Step 4
        If IsNumeric(Cells(rw, i)) Then
            hrs = Cells(rw, i + 1) - Cells(rw, i)
            If hrs < 0 Then hrs = hrs + 1
            If hrs > 0.5 Then
                Cells(rw, i).Resize(, 2).Interior.ColorIndex = 3  'Debug
                x = x + 1
            End If
        End If
    Next
    xOverHours = x
End Function


Function xUnderBreak(rw As Long)
    For i = 10 To 170 Step 4
        If IsNumeric(Cells(rw, i)) And IsNumeric(Cells(rw, i - 3)) _
        And Cells(rw, i) > 0 And Cells(rw, i - 3) > 0 Then
            hrs = Cells(rw, i) - Cells(rw, i - 3)
            If hrs < 0 Then hrs = hrs + 1
            If hrs > 0 And hrs < 11 / 24 Then
                Cells(rw, i - 3).Resize(, 4).Interior.ColorIndex = 4  'Debug
                x = x + 1
            End If
        End If
    Next
    xUnderBreak = x
End Function

---

Sir You are a lagend!

Thank you so much.

Is there a chance for me to see exactly how many hours there was?

Code:

---

Function OverHours(Data As Range)    rw = Data.Row
    x = 0
    For i = 6 To 170 Step 4
        If IsNumeric(Cells(rw, i)) And Cells(rw, i + 1) > 0 And Cells(rw, i) > 0 Then
            hrs = Cells(rw, i + 1) - Cells(rw, i)
            If hrs < 0 Then hrs = hrs + 1
            y = y + hrs
            Z = Z + 1
            If hrs > 0.5 Then
                x = x + 1
            End If
        End If
    Next
    If y > 0 Then
        OverHours = Format(y * 24, "0.0") & " hours in " & Z & " shifts with " & x & " over 12 hours"
    Else
        OverHours = "No hours recorded"
    End If
End Function

---

Make sure you test this properly; particularly where period cross days

all this looks great,

maybe I am doing something wrong but I see how many times 12 hour work time was longer

and i was wondering if there was chance to see if there was 6 over hours during period

it does not matter if that happens 2 or 3 times

If you prefer for clarity, write the fraction as 12/24, 6/24 etc.
Add another variable

Code:

---

If hrs > 0.5 Then x = x+1
If hrs > 0.25 and hrs <=0.5 Then w = w+1

---

sorry but i don't quite understand...

Change this area of Post #4 to Post #7. "W" will record the periods of 6 to 12 hours.

Code:

---

If hrs > 0.5 Then
                x = x + 1
            End If

---