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

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