Employee Schedule Creator

' Employee Schedule Creator
' Employees sheet: Name (A), Role (B), Max Hours/Week (C), Availability (D)
' Schedule sheet: Employee (row), Days (columns), Shift codes in cells
' Shift codes: M=Morning, A=Afternoon, N=Night, O=Off, H=Holiday

Sub CreateWeeklySchedule()
    ' Set up a blank weekly schedule grid
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    ' Get employees
    Dim wsEmp As Worksheet
    On Error Resume Next
    Set wsEmp = ThisWorkbook.Sheets("Employees")
    On Error GoTo ErrorHandler

    If wsEmp Is Nothing Then
        MsgBox "Please create an 'Employees' sheet with columns: Name, Role, Max Hours/Week, Availability", vbExclamation
        Exit Sub
    End If

    Dim lastEmpRow As Long
    lastEmpRow = wsEmp.Cells(wsEmp.Rows.Count, "A").End(xlUp).Row

    If lastEmpRow < 2 Then
        MsgBox "No employees found in Employees sheet.", vbExclamation
        Exit Sub
    End If

    ' Get week start date
    Dim weekStart As Date
    Dim dateInput As String
    dateInput = InputBox("Enter week start date (dd/mm/yyyy):", "Schedule Week", Format(Date - Weekday(Date, vbMonday) + 1, "dd/mm/yyyy"))
    If dateInput = "" Then Exit Sub
    weekStart = CDate(dateInput)

    ' Create schedule sheet
    Dim wsSched As Worksheet
    Dim schedName As String
    schedName = "Week " & Format(weekStart, "dd-mm")

    On Error Resume Next
    Set wsSched = ThisWorkbook.Sheets(schedName)
    On Error GoTo ErrorHandler

    If wsSched Is Nothing Then
        Set wsSched = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsSched.Name = schedName
    Else
        wsSched.Cells.Clear
    End If

    ' Title
    wsSched.Cells(1, 1).Value = "Employee Schedule - Week of " & Format(weekStart, "dd/mm/yyyy")
    wsSched.Cells(1, 1).Font.Size = 14
    wsSched.Cells(1, 1).Font.Bold = True
    wsSched.Range("A1:H1").Merge

    ' Legend
    wsSched.Cells(2, 1).Value = "Shift Codes: M=Morning (06:00-14:00) | A=Afternoon (14:00-22:00) | N=Night (22:00-06:00) | O=Off | H=Holiday"
    wsSched.Cells(2, 1).Font.Size = 9
    wsSched.Cells(2, 1).Font.Italic = True

    ' Day headers
    wsSched.Cells(4, 1).Value = "Employee"
    wsSched.Cells(4, 2).Value = "Role"

    Dim d As Long
    For d = 0 To 6
        Dim dayDate As Date
        dayDate = weekStart + d

' ... 173 more lines hidden ...
'
' Sign up for free to view the complete code
' Visit: vbacode.io