Time Counter

Hi, I have a time-sheet where employees book their time worked on various Jobs. Each Job (Reg5) also have certain activities (Reg6) connected to it. There is also an Hours Worked Textbox (Reg7). So it means a person will fill in the time sheet for each job he has done a day. For example Tom has worked on three jobs on Monday so he enters the time sheet and captures his time.... the First Job was 1 hour, the second 3 hrs and the last 4 hrs to make up for the 8 hours a day. Currently I have a counter that shows the time booked and the time left but it is not working perfectly. What I want is the following each time Tom fills in the time sheet the counters add up the hours if he gets past 8 hrs it must give a warning. Also on a Friday it is only 6 hrs total work time. The counter must be able to recognize each employee and counts their time book individually. The data is captured on Sheet 2 (Data) - Date, Weekday, LastName, FirstName, Job, Activity ID, Hours Worked and Payroll category. I do have a demo program but it is too large to upload - contact me for more detail.

Code:

---

Private Sub Reg7_change()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Sheets.Add
Range("A1").Formula = "=SUMIFS(Data!I:I,Data!C:C," & Reg1.Value & ",Data!E:E," & Reg3.Value & ",Data!F:F," & Reg4.Value & ")+ " & Reg7.Value & ""
Label29 = Range("A1").Value
Label32 = 8 - Label29

ActiveSheet.Delete
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://eileenslounge.com/viewtopic.php?p=316254#p316254
https://eileenslounge.com/viewtopic.php?p=316280#p316280
https://eileenslounge.com/viewtopic.php?p=315915#p315915
https://eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315744#p315744
https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315680#p315680
https://eileenslounge.com/viewtopic.php?p=315743#p315743
https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
https://eileenslounge.com/viewtopic.php?p=314950#p314950
https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://eileenslounge.com/viewtopic.php?p=317218#p317218
https://eileenslounge.com/viewtopic.php?p=316955#p316955
https://eileenslounge.com/viewtopic.php?p=316955#p316955
https://eileenslounge.com/viewtopic.php?p=316940#p316940
https://eileenslounge.com/viewtopic.php?p=316927#p316927
https://eileenslounge.com/viewtopic.php?p=317014#p317014
https://eileenslounge.com/viewtopic.php?p=317006#p317006
https://eileenslounge.com/viewtopic.php?p=316935#p316935
https://eileenslounge.com/viewtopic.php?p=316875#p316875
https://eileenslounge.com/viewtopic.php?p=316254#p316254
https://eileenslounge.com/viewtopic.php?p=316280#p316280
https://eileenslounge.com/viewtopic.php?p=315915#p315915
https://eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315744#p315744
https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
https://eileenslounge.com/viewtopic.php?p=315680#p315680
https://eileenslounge.com/viewtopic.php?p=315743#p315743
https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
https://eileenslounge.com/viewtopic.php?p=314950#p314950
https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Hi Mnet,

Welcome to board !

Can you please attach the workbook ?

Cut down the data if it's huge in size.

Thank you ;) - It is still too big even when cutting down almost all the data - Please see my private message. Thanks in advance...

keep 10 rows of data, zip the file and upload.

Dear Admin, hereby the data as discussed - Thank you!

Use this code. You don't need to create a sheet each time for calculation, instead use application.worksheetfunction.

Code:

---

    Dim TotHours    As Double
    Dim rngData    As Range
   
    With Worksheets("Data")
        Set rngData = .Range("c2:i" & .Range("c" & .rows.Count).End(xlUp).Row)
    End With
    TotHours = Application.WorksheetFunction.SumIfs(rngData.Columns(7), rngData.Columns(1), CDate(Reg1.Value), rngData.Columns(3), Reg3.Value, rngData.Columns(4), Reg4.Value)
   
    TotHours = TotHours + CDbl(Reg7.Value)
   
    Label29 = TotHours
    If TotHours > 8 Then
        MsgBox "Your warning message", vbExclamation
        Exit Sub
    End If
   
    Label32 = 8 - TotHours

---

Wonderful!!! Thank you it looks great!! Thank you for your time and effort it is much appreciated - On a Friday it is 6 hours would it be possible to distinguish between the 8 and 6 hours when filling in the time worked??

You are welcome!

Code:

---

    Dim TotHours    As Double
    Dim rngData    As Range
    Dim CutOff      As Double
   
    CutOff = 8
    If Application.WorksheetFunction.Weekday(DTPicker1, 2) = 5 Then CutOff = 6 'for Friday
   
    With Worksheets("Data")
        Set rngData = .Range("c2:i" & .Range("c" & .rows.Count).End(xlUp).Row)
    End With
    TotHours = Application.WorksheetFunction.SumIfs(rngData.Columns(7), rngData.Columns(1), CDate(Reg1.Value), rngData.Columns(3), Reg3.Value, rngData.Columns(4), Reg4.Value)
   
    TotHours = TotHours + CDbl(Reg7.Value)
   
    Label29 = TotHours
    If TotHours > CutOff Then
        MsgBox "Your warning message", vbExclamation
        Exit Sub
    End If
   
    Label32 = CutOff - TotHours

---

Weekday is a regular VBA-function

instead of

Code:

---

If Application.WorksheetFunction.Weekday(DTPicker1, 2) = 5 Then

---

use

Code:

---

If Weekday(DTPicker1, 2) = 5 Then

---

Excellent!! Thanks again for helping me - you are very kind!