Timesheet & Attendance Tracker
Track employee working hours, overtime, absences, and holidays with automatic calculations, weekly summaries, and exportable attendance reports.
13 views
Featured
Perfect For:
- Employee time tracking
- Overtime monitoring
- Attendance recording
- Payroll preparation
- Weekly hour summaries
VBA Code
' Timesheet & Attendance Tracker
' Sheet structure: Employee (A), Date (B), Clock In (C), Clock Out (D),
' Break (mins) (E), Hours Worked (F), Overtime (G), Status (H)
' Settings sheet: Standard Hours (B1), Overtime Threshold (B2)
Sub CalculateTimesheet()
' Calculate working hours, overtime, and attendance status
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ActiveSheet
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If lastRow < 2 Then
MsgBox "No timesheet data found. Please enter data from row 2.", vbExclamation
Exit Sub
End If
' Get settings
Dim standardHours As Double
Dim overtimeThreshold As Double
On Error Resume Next
Dim wsSettings As Worksheet
Set wsSettings = ThisWorkbook.Sheets("Settings")
On Error GoTo ErrorHandler
If Not wsSettings Is Nothing Then
standardHours = Val(wsSettings.Range("B1").Value)
overtimeThreshold = Val(wsSettings.Range("B2").Value)
End If
If standardHours = 0 Then standardHours = 8
If overtimeThreshold = 0 Then overtimeThreshold = 8
' Validate headers
If ws.Cells(1, 1).Value = "" Then
ws.Cells(1, 1).Value = "Employee"
ws.Cells(1, 2).Value = "Date"
ws.Cells(1, 3).Value = "Clock In"
ws.Cells(1, 4).Value = "Clock Out"
ws.Cells(1, 5).Value = "Break (mins)"
ws.Cells(1, 6).Value = "Hours Worked"
ws.Cells(1, 7).Value = "Overtime"
ws.Cells(1, 8).Value = "Status"
With ws.Range("A1:H1")
.Font.Bold = True
.Interior.Color = RGB(0, 102, 204)
.Font.Color = RGB(255, 255, 255)
End With
End If
Dim i As Long
For i = 2 To lastRow
Dim clockIn As Date
Dim clockOut As Date
Dim breakMins As Double
Dim hoursWorked As Double
Dim overtime As Double
Dim status As String
' Skip if no clock in time
If ws.Cells(i, 3).Value = "" Then
ws.Cells(i, 8).Value = "Absent"
ws.Cells(i, 8).Interior.Color = RGB(255, 200, 200)
GoTo NextRow
End If
clockIn = CDate(ws.Cells(i, 3).Value)
' Check if still clocked in
If ws.Cells(i, 4).Value = "" Then
ws.Cells(i, 8).Value = "Clocked In"
ws.Cells(i, 8).Interior.Color = RGB(255, 255, 200)
GoTo NextRow
End If
clockOut = CDate(ws.Cells(i, 4).Value)
breakMins = Val(ws.Cells(i, 5).Value)
' Calculate hours worked
hoursWorked = (clockOut - clockIn) * 24 - (breakMins / 60)
' Handle negative (overnight shifts)
If hoursWorked < 0 Then hoursWorked = hoursWorked + 24
' Round to 2 decimal places
hoursWorked = Round(hoursWorked, 2)
' Calculate overtime
If hoursWorked > overtimeThreshold Then
overtime = Round(hoursWorked - overtimeThreshold, 2)
Else
overtime = 0
End If
' Determine status
If hoursWorked >= standardHours Then
status = "Full Day"
ElseIf hoursWorked >= standardHours / 2 Then
status = "Half Day"
ElseIf hoursWorked > 0 Then
status = "Partial"
Else
status = "Absent"
End If
' Write results
ws.Cells(i, 6).Value = hoursWorked
ws.Cells(i, 6).NumberFormat = "0.00"
ws.Cells(i, 7).Value = overtime
ws.Cells(i, 7).NumberFormat = "0.00"
ws.Cells(i, 8).Value = status
' Colour code status
Select Case status
Case "Full Day"
ws.Cells(i, 8).Interior.Color = RGB(200, 240, 200)
Case "Half Day"
ws.Cells(i, 8).Interior.Color = RGB(255, 255, 200)
Case "Partial"
ws.Cells(i, 8).Interior.Color = RGB(255, 230, 200)
Case "Absent"
ws.Cells(i, 8).Interior.Color = RGB(255, 200, 200)
End Select
' Highlight overtime
If overtime > 0 Then
ws.Cells(i, 7).Interior.Color = RGB(255, 220, 180)
ws.Cells(i, 7).Font.Bold = True
End If
NextRow:
Next i
' Auto-fit columns
ws.Columns("A:H").AutoFit
Application.ScreenUpdating = True
MsgBox "Timesheet calculations complete!", vbInformation
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
MsgBox "Error calculating timesheet: " & Err.Description, vbCritical
End Sub
Sub GenerateWeeklySummary()
' Create weekly summary by employee
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ActiveSheet
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Collect unique employees
Dim employees As Object
Set employees = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 2 To lastRow
Dim empName As String
empName = Trim(ws.Cells(i, 1).Value)
If empName <> "" And Not employees.Exists(empName) Then
employees.Add empName, 0
End If
Next i
' Create summary sheet
Dim wsSummary As Worksheet
On Error Resume Next
Set wsSummary = ThisWorkbook.Sheets("Weekly Summary")
On Error GoTo ErrorHandler
If wsSummary Is Nothing Then
Set wsSummary = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsSummary.Name = "Weekly Summary"
Else
wsSummary.Cells.Clear
End If
' Summary headers
wsSummary.Cells(1, 1).Value = "Weekly Attendance Summary"
wsSummary.Cells(1, 1).Font.Size = 16
wsSummary.Cells(1, 1).Font.Bold = True
wsSummary.Cells(2, 1).Value = "Generated: " & Format(Now, "dd/mm/yyyy hh:mm")
wsSummary.Cells(4, 1).Value = "Employee"
wsSummary.Cells(4, 2).Value = "Days Worked"
wsSummary.Cells(4, 3).Value = "Total Hours"
wsSummary.Cells(4, 4).Value = "Total Overtime"
wsSummary.Cells(4, 5).Value = "Absences"
wsSummary.Cells(4, 6).Value = "Avg Hours/Day"
With wsSummary.Range("A4:F4")
.Font.Bold = True
.Interior.Color = RGB(0, 102, 204)
.Font.Color = RGB(255, 255, 255)
End With
' Calculate per employee
Dim summaryRow As Long
summaryRow = 5
Dim emp As Variant
For Each emp In employees.Keys
Dim daysWorked As Long
Dim totalHours As Double
Dim totalOvertime As Double
Dim absences As Long
daysWorked = 0
totalHours = 0
totalOvertime = 0
absences = 0
For i = 2 To lastRow
If Trim(ws.Cells(i, 1).Value) = emp Then
If ws.Cells(i, 8).Value = "Absent" Then
absences = absences + 1
ElseIf ws.Cells(i, 6).Value > 0 Then
daysWorked = daysWorked + 1
totalHours = totalHours + Val(ws.Cells(i, 6).Value)
totalOvertime = totalOvertime + Val(ws.Cells(i, 7).Value)
End If
End If
Next i
wsSummary.Cells(summaryRow, 1).Value = emp
wsSummary.Cells(summaryRow, 2).Value = daysWorked
wsSummary.Cells(summaryRow, 3).Value = Round(totalHours, 2)
wsSummary.Cells(summaryRow, 3).NumberFormat = "0.00"
wsSummary.Cells(summaryRow, 4).Value = Round(totalOvertime, 2)
wsSummary.Cells(summaryRow, 4).NumberFormat = "0.00"
wsSummary.Cells(summaryRow, 5).Value = absences
If daysWorked > 0 Then
wsSummary.Cells(summaryRow, 6).Value = Round(totalHours / daysWorked, 2)
Else
wsSummary.Cells(summaryRow, 6).Value = 0
End If
wsSummary.Cells(summaryRow, 6).NumberFormat = "0.00"
' Highlight high overtime
If totalOvertime > 10 Then
wsSummary.Cells(summaryRow, 4).Interior.Color = RGB(255, 220, 180)
End If
' Highlight absences
If absences > 2 Then
wsSummary.Cells(summaryRow, 5).Interior.Color = RGB(255, 200, 200)
End If
summaryRow = summaryRow + 1
Next emp
wsSummary.Columns("A:F").AutoFit
Application.ScreenUpdating = True
MsgBox "Weekly summary generated in 'Weekly Summary' sheet!", vbInformation
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
MsgBox "Error generating summary: " & Err.Description, vbCritical
End Sub
Related Topics
timesheet
attendance
hours
overtime
payroll
Need Custom VBA Solutions?
Our AI-powered VBA generator can create custom code tailored to your specific requirements in seconds.
3 free generations/month — unlimited with Pro
Related Templates
More VBA templates in the same category
Intermediate
Data Entry Form with Validation
Professional UserForm-based data entry system with field validation, dropdown lists, date pickers...
View Template
Intermediate
Create Sheet Per Unique Value
Automatically create separate worksheets for each unique value in a column. Perfect for splitting...
View Template