Project Timeline & Gantt Chart

' Project Timeline & Gantt Chart Generator
' Task sheet: Task Name (A), Start Date (B), End Date (C), Duration Days (D),
'   Progress % (E), Assignee (F), Status (G), Dependency (H)

Sub GenerateGanttChart()
    ' Create a visual Gantt chart from task data
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim wsTask As Worksheet
    Set wsTask = ActiveSheet

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

    If lastRow < 2 Then
        MsgBox "No task data found. Please enter tasks from row 2.", vbExclamation
        Exit Sub
    End If

    ' Ensure headers
    If wsTask.Cells(1, 1).Value = "" Then
        wsTask.Cells(1, 1).Value = "Task Name"
        wsTask.Cells(1, 2).Value = "Start Date"
        wsTask.Cells(1, 3).Value = "End Date"
        wsTask.Cells(1, 4).Value = "Duration (Days)"
        wsTask.Cells(1, 5).Value = "Progress %"
        wsTask.Cells(1, 6).Value = "Assignee"
        wsTask.Cells(1, 7).Value = "Status"
        wsTask.Cells(1, 8).Value = "Dependency"

        With wsTask.Range("A1:H1")
            .Font.Bold = True
            .Interior.Color = RGB(0, 102, 204)
            .Font.Color = RGB(255, 255, 255)
        End With
    End If

    ' Calculate durations and auto-fill end dates
    Dim i As Long
    For i = 2 To lastRow
        If wsTask.Cells(i, 2).Value <> "" Then
            Dim startDate As Date
            startDate = CDate(wsTask.Cells(i, 2).Value)

            ' If end date is empty but duration is set, calculate end date
            If wsTask.Cells(i, 3).Value = "" And Val(wsTask.Cells(i, 4).Value) > 0 Then
                wsTask.Cells(i, 3).Value = startDate + Val(wsTask.Cells(i, 4).Value) - 1
                wsTask.Cells(i, 3).NumberFormat = "dd/mm/yyyy"
            End If

            ' If end date exists, calculate duration
            If wsTask.Cells(i, 3).Value <> "" Then
                Dim endDate As Date
                endDate = CDate(wsTask.Cells(i, 3).Value)
                wsTask.Cells(i, 4).Value = DateDiff("d", startDate, endDate) + 1
            End If

            ' Determine status based on progress
            Dim progress As Double
            progress = Val(wsTask.Cells(i, 5).Value)

            If progress >= 100 Then
                wsTask.Cells(i, 7).Value = "Complete"
                wsTask.Cells(i, 7).Interior.Color = RGB(200, 240, 200)
            ElseIf progress > 0 Then
                wsTask.Cells(i, 7).Value = "In Progress"
                wsTask.Cells(i, 7).Interior.Color = RGB(200, 230, 255)
            ElseIf endDate < Date Then
                wsTask.Cells(i, 7).Value = "Overdue"
                wsTask.Cells(i, 7).Interior.Color = RGB(255, 150, 150)
            Else
                wsTask.Cells(i, 7).Value = "Not Started"
                wsTask.Cells(i, 7).Interior.Color = RGB(230, 230, 230)
            End If
        End If
    Next i

    ' Find project date range
    Dim projectStart As Date
    Dim projectEnd As Date
    projectStart = CDate(wsTask.Cells(2, 2).Value)
    projectEnd = CDate(wsTask.Cells(2, 3).Value)

    For i = 2 To lastRow
        If wsTask.Cells(i, 2).Value <> "" Then
            If CDate(wsTask.Cells(i, 2).Value) < projectStart Then
                projectStart = CDate(wsTask.Cells(i, 2).Value)
            End If
            If CDate(wsTask.Cells(i, 3).Value) > projectEnd Then
                projectEnd = CDate(wsTask.Cells(i, 3).Value)
            End If
        End If
    Next i

    ' Create Gantt chart sheet
    Dim wsGantt As Worksheet
    On Error Resume Next
    Set wsGantt = ThisWorkbook.Sheets("Gantt Chart")
    On Error GoTo ErrorHandler

    If wsGantt Is Nothing Then
        Set wsGantt = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsGantt.Name = "Gantt Chart"
    Else
        wsGantt.Cells.Clear
    End If

    ' Title
    wsGantt.Cells(1, 1).Value = "Project Gantt Chart"
    wsGantt.Cells(1, 1).Font.Size = 16
    wsGantt.Cells(1, 1).Font.Bold = True

    wsGantt.Cells(2, 1).Value = "Generated: " & Format(Now, "dd/mm/yyyy hh:mm")
    wsGantt.Cells(2, 1).Font.Italic = True

    ' Task column headers
    wsGantt.Cells(4, 1).Value = "Task"
    wsGantt.Cells(4, 2).Value = "Assignee"
    wsGantt.Cells(4, 3).Value = "Progress"
    wsGantt.Cells(4, 1).Font.Bold = True
    wsGantt.Cells(4, 2).Font.Bold = True
    wsGantt.Cells(4, 3).Font.Bold = True

    ' Date headers across top
    Dim totalDays As Long
    totalDays = DateDiff("d", projectStart, projectEnd) + 1

    ' Limit columns for readability (group by weeks if > 60 days)
    Dim useWeeks As Boolean
    Dim colCount As Long

    If totalDays > 60 Then
        useWeeks = True
        colCount = Int(totalDays / 7) + 1
    Else
        useWeeks = False
        colCount = totalDays
    End If

    ' Cap at 90 columns
    If colCount > 90 Then colCount = 90

    Dim col As Long
    For col = 1 To colCount
        Dim headerDate As Date
        If useWeeks Then
            headerDate = projectStart + ((col - 1) * 7)
            wsGantt.Cells(4, col + 3).Value = Format(headerDate, "dd/mm")
        Else
            headerDate = projectStart + (col - 1)
            wsGantt.Cells(4, col + 3).Value = Format(headerDate, "dd")

            ' Highlight weekends
            If Weekday(headerDate, vbMonday) > 5 Then
                wsGantt.Cells(4, col + 3).Interior.Color = RGB(240, 240, 240)
            End If
        End If

        wsGantt.Cells(4, col + 3).Font.Size = 8
        wsGantt.Cells(4, col + 3).HorizontalAlignment = xlCenter
        wsGantt.Columns(col + 3).ColumnWidth = 3
    Next col

    wsGantt.Range(wsGantt.Cells(4, 1), wsGantt.Cells(4, colCount + 3)).Interior.Color = RGB(0, 102, 204)
    wsGantt.Range(wsGantt.Cells(4, 1), wsGantt.Cells(4, colCount + 3)).Font.Color = RGB(255, 255, 255)

    ' Draw Gantt bars
    Dim ganttRow As Long
    ganttRow = 5

    For i = 2 To lastRow
        If wsTask.Cells(i, 2).Value <> "" Then
            wsGantt.Cells(ganttRow, 1).Value = wsTask.Cells(i, 1).Value
            wsGantt.Cells(ganttRow, 2).Value = wsTask.Cells(i, 6).Value
            wsGantt.Cells(ganttRow, 3).Value = Val(wsTask.Cells(i, 5).Value) & "%"
            wsGantt.Cells(ganttRow, 3).HorizontalAlignment = xlCenter

            Dim taskStart As Date
            Dim taskEnd As Date
            taskStart = CDate(wsTask.Cells(i, 2).Value)
            taskEnd = CDate(wsTask.Cells(i, 3).Value)
            progress = Val(wsTask.Cells(i, 5).Value)

            ' Calculate bar position
            Dim startCol As Long
            Dim endCol As Long

            If useWeeks Then
                startCol = Int(DateDiff("d", projectStart, taskStart) / 7) + 4
                endCol = Int(DateDiff("d", projectStart, taskEnd) / 7) + 4
            Else
                startCol = DateDiff("d", projectStart, taskStart) + 4
                endCol = DateDiff("d", projectStart, taskEnd) + 4
            End If

            ' Ensure within bounds
            If startCol < 4 Then startCol = 4
            If endCol > colCount + 3 Then endCol = colCount + 3

            ' Draw bar
            Dim barColor As Long
            Select Case wsTask.Cells(i, 7).Value
                Case "Complete"
                    barColor = RGB(100, 180, 100)
                Case "In Progress"
                    barColor = RGB(100, 150, 220)
                Case "Overdue"
                    barColor = RGB(220, 80, 80)
                Case Else
                    barColor = RGB(180, 180, 180)
            End Select

            For col = startCol To endCol
                wsGantt.Cells(ganttRow, col).Interior.Color = barColor
            Next col

            ' Draw progress overlay (darker shade)
            If progress > 0 And progress < 100 Then
                Dim progressCols As Long
                progressCols = Int((endCol - startCol + 1) * progress / 100)

                For col = startCol To startCol + progressCols - 1
                    wsGantt.Cells(ganttRow, col).Interior.Color = RGB(50, 100, 50)
                Next col
            End If

            ' Alternate row shading for task info columns
            If (ganttRow - 5) Mod 2 = 1 Then
                wsGantt.Range("A" & ganttRow & ":C" & ganttRow).Interior.Color = RGB(245, 248, 252)
            End If

            ganttRow = ganttRow + 1
        End If
    Next i

    ' Today marker
    If Date >= projectStart And Date <= projectEnd Then
        Dim todayCol As Long
        If useWeeks Then
            todayCol = Int(DateDiff("d", projectStart, Date) / 7) + 4
        Else
            todayCol = DateDiff("d", projectStart, Date) + 4
        End If

        For Dim r = 4 To ganttRow - 1
            wsGantt.Cells(r, todayCol).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
            wsGantt.Cells(r, todayCol).Borders(xlEdgeLeft).Weight = xlMedium
        Next r
    End If

    ' Set column widths
    wsGantt.Columns("A").ColumnWidth = 25
    wsGantt.Columns("B").ColumnWidth = 15
    wsGantt.Columns("C").ColumnWidth = 10

    ' Add legend
    Dim legendRow As Long
    legendRow = ganttRow + 2
    wsGantt.Cells(legendRow, 1).Value = "Legend:"
    wsGantt.Cells(legendRow, 1).Font.Bold = True

    wsGantt.Cells(legendRow + 1, 1).Value = "Complete"
    wsGantt.Cells(legendRow + 1, 2).Interior.Color = RGB(100, 180, 100)
    wsGantt.Cells(legendRow + 2, 1).Value = "In Progress"
    wsGantt.Cells(legendRow + 2, 2).Interior.Color = RGB(100, 150, 220)
    wsGantt.Cells(legendRow + 3, 1).Value = "Overdue"
    wsGantt.Cells(legendRow + 3, 2).Interior.Color = RGB(220, 80, 80)
    wsGantt.Cells(legendRow + 4, 1).Value = "Not Started"
    wsGantt.Cells(legendRow + 4, 2).Interior.Color = RGB(180, 180, 180)

    Application.ScreenUpdating = True

    MsgBox "Gantt chart generated with " & (lastRow - 1) & " tasks!" & vbCrLf & _
           "Project span: " & Format(projectStart, "dd/mm/yyyy") & " to " & Format(projectEnd, "dd/mm/yyyy"), vbInformation

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "Error generating Gantt chart: " & Err.Description, vbCritical
End Sub

Sub UpdateProgress()
    ' Quick progress update for selected task
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = ActiveSheet

    If ws.Name = "Gantt Chart" Then
        MsgBox "Please switch to the task data sheet to update progress.", vbExclamation
        Exit Sub
    End If

    Dim selectedRow As Long
    selectedRow = ActiveCell.Row

    If selectedRow < 2 Or ws.Cells(selectedRow, 1).Value = "" Then
        MsgBox "Please select a task row to update.", vbExclamation
        Exit Sub
    End If

    Dim taskName As String
    taskName = ws.Cells(selectedRow, 1).Value

    Dim currentProgress As Double
    currentProgress = Val(ws.Cells(selectedRow, 5).Value)

    Dim newProgress As String
    newProgress = InputBox("Update progress for: " & taskName & vbCrLf & _
                          "Current progress: " & currentProgress & "%" & vbCrLf & vbCrLf & _
                          "Enter new progress (0-100):", "Update Progress", currentProgress)

    If newProgress = "" Then Exit Sub

    Dim progressVal As Double
    progressVal = Val(newProgress)

    If progressVal < 0 Or progressVal > 100 Then
        MsgBox "Progress must be between 0 and 100.", vbExclamation
        Exit Sub
    End If

    ws.Cells(selectedRow, 5).Value = progressVal

    ' Regenerate Gantt chart
    If MsgBox("Refresh Gantt chart?", vbYesNo + vbQuestion) = vbYes Then
        Call GenerateGanttChart
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error updating progress: " & Err.Description, vbCritical
End Sub