Timesheet & Attendance Tracker
Track employee working hours, overtime, absences, and holidays with automatic calculations, weekly summaries, and exportable attendance reports.
1629 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.
Free AI generations every month — top up with credit packs anytime
Related Templates
More VBA templates in the same category
Intermediate
CSV Import with Data Types
Import CSV files with automatic data type detection and formatting
View Template
Beginner
Data Processing & Cleanup
Remove duplicates, clean data formats, and standardise entries
View Template
Intermediate
Data Entry Form with Validation
Professional UserForm-based data entry system with field validation, dropdown lists, date pickers...
View Template