PDA

View Full Version : Time Counter



Mnet
12-05-2017, 03:30 AM
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.

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://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=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316280#p316280 (https://eileenslounge.com/viewtopic.php?p=316280#p316280)
https://eileenslounge.com/viewtopic.php?p=315915#p315915 (https://eileenslounge.com/viewtopic.php?p=315915#p315915)
https://eileenslounge.com/viewtopic.php?p=315512#p315512 (https://eileenslounge.com/viewtopic.php?p=315512#p315512)
https://eileenslounge.com/viewtopic.php?p=315744#p315744 (https://eileenslounge.com/viewtopic.php?p=315744#p315744)
https://www.eileenslounge.com/viewtopic.php?p=315512#p315512 (https://www.eileenslounge.com/viewtopic.php?p=315512#p315512)
https://eileenslounge.com/viewtopic.php?p=315680#p315680 (https://eileenslounge.com/viewtopic.php?p=315680#p315680)
https://eileenslounge.com/viewtopic.php?p=315743#p315743 (https://eileenslounge.com/viewtopic.php?p=315743#p315743)
https://www.eileenslounge.com/viewtopic.php?p=315326#p315326 (https://www.eileenslounge.com/viewtopic.php?p=315326#p315326)
https://www.eileenslounge.com/viewtopic.php?f=30&t=40752 (https://www.eileenslounge.com/viewtopic.php?f=30&t=40752)
https://eileenslounge.com/viewtopic.php?p=314950#p314950 (https://eileenslounge.com/viewtopic.php?p=314950#p314950)
https://www.eileenslounge.com/viewtopic.php?p=314940#p314940 (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=314926#p314926)
https://www.eileenslounge.com/viewtopic.php?p=314920#p314920 (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=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=21&t=40701&p=314836#p314836)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621 (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)

Admin
12-05-2017, 08:17 AM
Hi Mnet,

Welcome to board !

Can you please attach the workbook ?

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

Mnet
12-05-2017, 09:25 AM
Thank you ;) - It is still too big even when cutting down almost all the data - Please see my private message. Thanks in advance...

Admin
12-05-2017, 12:05 PM
keep 10 rows of data, zip the file and upload.

Mnet
12-06-2017, 01:24 AM
Dear Admin, hereby the data as discussed - Thank you!

Admin
12-06-2017, 08:33 AM
Use this code. You don't need to create a sheet each time for calculation, instead use application.worksheetfunction.


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.Colum ns(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

Mnet
12-06-2017, 09:02 AM
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??

Admin
12-06-2017, 01:26 PM
You are welcome!


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.Colum ns(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

snb
12-06-2017, 05:32 PM
Weekday is a regular VBA-function

instead of

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

use

If Weekday(DTPicker1, 2) = 5 Then

Mnet
12-07-2017, 02:03 AM
Excellent!! Thanks again for helping me - you are very kind!

Mnet
12-07-2017, 02:04 AM
Thank you SNB - great advice!!