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