Timesheet & Attendance Tracker

Track employee working hours, overtime, absences, and holidays with automatic calculations, weekly summaries, and exportable attendance reports.

5 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