Time Sheet Query

[pedrods]

Hi there everyone,

I need some help please with this little project i decided to put together.

Essentially, the idea is an excel sheet with everyday of the week represented by a tab each. I use a barcode scanner gun to scan employee names into the sheet. The sheet automatically writes a time stamp everytime a new employee is scanned into the Monday tab for example.

A simple formula then works out the total hours for the day for each employee. The next bit is where i get lost, i want each employee "total day worked time", Monday - Saturday to show as a total weekly hours worked on a separate tab which summarises each tab's employee hours worked.

Each tab which represents a day of the week will have each employee scan in to the sheet randomly through out the week, so no two days are the same.

1. Scan in
2. Scan out
3. Calculate total time per day
4. Calculate total employee time for the week
5. Calculate Overtime worked

That's basically what im trying to achieve, but want it to be automated so i dont have to create pivot tables each week or "consolidate" functions which are all manual options.

How hard can this be?

(Below i have attached a quick snapshot of what the format looks like when it captures the data i want.

There's Time in and Out - two times to allow for breaks etc.

:-/

Name	Total	Time In	Time Out	Time In2	Time Out3
Peter	08:57:00	11:02	18:00	18:01	20:00
Adrian	08:58:00	11:02	20:00
Fred	10:58:00	11:02	22:00
Bob	11:58:00	11:02	23:00
Terry	11:52:00	11:08	23:00
Jannet	12:21:00	11:11	23:32
Ola	01:00:00	12:59	13:59
Yanky	00:06:00	12:00	12:06

<tbody>
</tbody>

 

[D3allamerican07]

Pedrods,

I wrote a script that filters and calculates each employees time and overtime hours. Your workbook should have 5 tabs (e.g. Monday, Tuesday, Wednesday, Thursday, Friday) and then add an additional one named "Total".

Label cell A1 = Name, B1 = Total, C1 = Overtime, and D1 = 40:00:00.


Sub Timesheet_Code()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sht = Sheets.Add(After:=Sheets(Worksheets.Count))
sht.Name = "Calc"

With Sheets("Calc")
.Range("A1").Value = "Name"
.Range("B1").Value = "Overtime"
.Range("C1").Value = "Name"
.Range("d1").Value = "Name"
.Range("e1").Value = "Name"
.Range("f1").Value = "Name"
.Range("g1").Value = "Name"
.Range("h1").Value = "Name"
.Range("i1").Value = "Name"
.Range("j1").Value = "Name"
.Range("k1").Value = "Name"
.Range("l1").Value = "Name"
.Range("m1").Value = "Name"
End With

For Each ws In ActiveWorkbook.Worksheets

If ws.Name <> "Total" And ws.Name <> "Calc" Then

Sheets(ws.Name).Activate

lrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
lrow2 = Sheets("Calc").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

Sheets(ws.Name).UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Calc").Range("A" & lrow2 + 1)

End If
Next ws

Sheets("Calc").Activate

lrow3 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="Name"

ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Delete

ActiveSheet.AutoFilterMode = False

ActiveSheet.Range("A1:A" & lrow3).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("O1"), Unique:=True

lrow4 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
lrow5 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "O").End(xlUp).Row

Set Rng = ActiveSheet.Range("O2:O" & lrow5)

For Each cell In Rng

lrow6 = Sheets("Total").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=cell.Value
Set Rng2 = ActiveSheet.Range("B2:B" & lrow4)

ActiveSheet.Columns("B").SpecialCells(xlCellTypeVisible).Select

totalTime = Application.WorksheetFunction.Sum(Range("B:B").SpecialCells(xlCellTypeVisible))

Name = Sheets("Calc").UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
Sheets("Total").Range("A" & lrow6 + 1).Value = Name
Sheets("Total").Range("B" & lrow6 + 1).Value = totalTime
Next cell

Sheets("Calc").Delete
Sheets("Total").Activate

lrow7 = Sheets("Total").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

ActiveSheet.Range("B2:C" & lrow7).NumberFormat = "[h]:mm:ss"

Set rng3 = ActiveSheet.Range("C2:C" & lrow7)
For Each cell In rng3
If ActiveSheet.Range("B" & cell.Row) > ActiveSheet.Range("D1") Then
cell.Formula = ActiveSheet.Range("B" & cell.Row) - ActiveSheet.Range("D1")
Else
cell.Value = 0
End If
Next cell

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub


Let me know if you have any questions.

Bill

 

[pedrods]

Hi Bill,

Thanks heaps for posting that script up!

I gave that a go and having some issues with it.

So there's 5 tabs, Monday, Tuesday etc Friday (there should be a saturday).

There's already a script running in the background which is capturing the barcoded name into the cells and attaching a time stamp into C2 for example.

Not sure what's happening now, but the script seems to be changing the name of the 5th tab to one of the names of the drivers im using as a test. The format of the table it creates in the "Calc" tab does not seem to be calculating the totals or overtime amounts.

I have attached a link to the sheet im referring to with the changes.

https://drive.google.com/open?id=0B7qopu0_A1RNQ0VtSFpoZ0kyU3M

Appreciate your help

Pedro

 

[D3allamerican07]

Pedro,

I altered the script slightly. The "Calc" tab doesn't actually calculate any of their times rather just combines the people and their hours during the week. From their it filters and throws the time in the "Total" tab. Because it deals with time also, the times might be calculated as decimals first, then converted to [h]:mm:ss.

https://drive.google.com/open?id=0BztiOmfJyzBndHZ0RWduRTFORjQ

Sub Timesheet_Code()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set sht = Sheets.Add(After:=Sheets(Worksheets.Count))
    sht.Name = "Calc"
        
    With Sheets("Calc")
        .Range("A1").Value = "Name"
        .Range("B1").Value = "Overtime"
        .Range("C1").Value = "Header"
        .Range("d1").Value = "Header"
        .Range("e1").Value = "Header"
        .Range("f1").Value = "Header"
        .Range("g1").Value = "Header"
        .Range("h1").Value = "Header"
        .Range("i1").Value = "Header"
        .Range("j1").Value = "Header"
        .Range("k1").Value = "Header"
        .Range("l1").Value = "Header"
        .Range("m1").Value = "Header"
    End With
 
        lrow6 = Sheets("Total").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
        If lrow6 > 1 Then
            Sheets("Total").Range("A2:C" & lrow6).ClearContents
        End If
        
For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "Total" And ws.Name <> "Calc" Then
        
        Sheets(ws.Name).Activate
        
        lrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
        lrow2 = Sheets("Calc").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
        
        Sheets(ws.Name).UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Calc").Range("A" & lrow2 + 1)
        
    End If
Next ws

Sheets("Calc").Activate
    
    lrow3 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
        
        ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="Name"
        
            ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Delete
        
        ActiveSheet.AutoFilterMode = False
        
        ActiveSheet.Range("A1:A" & lrow3).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("O1"), Unique:=True
            
    lrow4 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    lrow5 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "O").End(xlUp).Row
       
    Set Rng = ActiveSheet.Range("O2:O" & lrow5)
    
    For Each cell In Rng
        
        ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=cell.Value
            Set Rng2 = ActiveSheet.Range("B2:B" & lrow4)
            
            lrow6 = Sheets("Total").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
            
            ActiveSheet.Columns("B").SpecialCells(xlCellTypeVisible).Select
            
            totalTime = Application.WorksheetFunction.Sum(Range("B:B").SpecialCells(xlCellTypeVisible))
            
            Name = Sheets("Calc").UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
            Sheets("Total").Range("A" & lrow6 + 1).Value = Name
            Sheets("Total").Range("B" & lrow6 + 1).Value = totalTime
    Next cell

Sheets("Calc").Delete
Sheets("Total").Activate

lrow7 = Sheets("Total").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

Set rng3 = ActiveSheet.Range("C2:C" & lrow7)
For Each cell In rng3
    If ActiveSheet.Range("B" & cell.Row) > 1.66666666 Then
        cell.Formula = ActiveSheet.Range("B" & cell.Row) - 1.66666666
    Else
        cell.Value = 0
    End If
Next cell

ActiveSheet.Range("B2:C" & lrow7).NumberFormat = "[h]:mm:ss"
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Let me know if you have any more trouble.

Bill