Building a VBA-Powered Dynamic Gantt Chart Engine: Programmatically Generate, Update, and Format Project Timelines Using Conditional Formatting and Shape Automation

Introduction

Picture this: your project manager drops a new 40-task project plan into your inbox every Monday morning. It's a flat list of tasks with start dates, durations, and owners — and your job is to turn it into a visual Gantt chart before the 9 AM standup. If you're doing this manually — dragging cells, applying colors, adjusting column widths — you're spending 45 minutes on something a well-built macro could finish in under three seconds.

Gantt charts sit at a genuinely awkward intersection for Excel. They're visual enough that native chart types don't handle them cleanly, but structured enough that manual formatting is tedious and error-prone. The sweet spot is a hybrid approach: a data table that drives everything, and a VBA engine that reads that table and renders the timeline automatically — complete with task bars, milestone markers, phase groupings, color-coded owners, and date headers. When a date changes, you re-run the engine and the chart rebuilds itself from scratch.

By the end of this lesson, you'll have built a complete, production-ready Gantt chart engine in VBA. It will generate timeline headers, draw task bars using both conditional formatting and Shape objects, handle milestones, apply color by owner, and respond to data changes — all without you touching the visual layer manually.

What you'll learn:

• How to architect a Gantt chart data model that drives visual output
• How to generate dynamic date headers and calculate bar positions programmatically
• How to use conditional formatting rules via VBA to color cells based on date logic
• How to overlay Excel Shape objects to draw precise task bars and milestone diamonds
• How to wire everything together into a self-contained engine with a single entry point
• How to handle common edge cases: tasks spanning weekends, milestones, cross-month spans, and overlapping phases

---

Prerequisites

You should be comfortable with:

• Writing and running VBA macros (see Getting Started with VBA Macros in Excel if you need a refresher)
• Working with ranges, cells, and worksheets in VBA — especially loops over row/column ranges (covered deeply in Working with Ranges, Cells, and Worksheets in VBA for Data Professionals)
• Basic understanding of the Excel object model (Understanding Excel's Object Model is a solid reference)
• Loops and conditional logic in VBA (Automating Repetitive Tasks with VBA Loops and Conditions)

You don't need prior experience with Excel's Shape object model or conditional formatting via VBA — we'll build that up from scratch.

---

Designing the Data Model

Before writing a single line of VBA, you need a data structure that the engine can reliably read. Resist the temptation to mirror how Gantt charts look; design for how they're built.

Set up a sheet called ProjectData with the following columns:

Column	Header	Data Type	Example
A	TaskID	Text	T-01
B	Phase	Text	Discovery
C	TaskName	Text	Stakeholder interviews
D	Owner	Text	Sarah K.
E	StartDate	Date	2025-02-03
F	EndDate	Date	2025-02-07
G	IsMilestone	Boolean (1/0)	0
H	PercentComplete	Number (0-100)	75

Add a second sheet called GanttChart — this is where the engine will draw everything. Leave it blank; VBA will own it entirely.

Add a third sheet called Config with named parameters:

Cell	Name	Value
B2	cfg_StartDate	2025-02-01
B3	cfg_EndDate	2025-04-30
B4	cfg_RowHeight	22
B5	cfg_ColWidth	18
B6	cfg_HeaderRows	3

This separation — data on ProjectData, rendering on GanttChart, parameters on Config — is what makes the engine maintainable. When the project scope changes, you edit data or config. The chart regenerates.

---

Building the Engine Architecture

The engine will consist of four coordinated procedures:

1. BuildGantt — the master entry point that orchestrates everything
2. RenderHeaders — writes date headers across the top
3. RenderTaskRows — writes task names down the left and draws bars to the right
4. ApplyConditionalFormatting — adds CF rules for live visual feedback
5. DrawShapeBars — draws Shape overlays for precise bar rendering and milestones

Let's start with the module setup and the master procedure.

Module Setup and Constants

Open the VBA editor (Alt+F11), insert a new module, and name it GanttEngine. Start with your constants and module-level variables:

Option Explicit

' === Layout Constants ===
Private Const DATA_SHEET As String = "ProjectData"
Private Const CHART_SHEET As String = "GanttChart"
Private Const CONFIG_SHEET As String = "Config"

Private Const FIRST_DATA_ROW As Long = 2        ' Row where tasks begin on ProjectData
Private Const GANTT_DATA_START_ROW As Long = 4  ' First task row on GanttChart
Private Const GANTT_DATA_START_COL As Long = 5  ' First date column on GanttChart (column E)
Private Const TASK_INFO_COLS As Long = 4         ' Columns A-D: ID, Phase, Name, Owner

' === Color Palette for Owners ===
Private Const COLOR_OWNER1 As Long = 4472191    ' Steel blue
Private Const COLOR_OWNER2 As Long = 5296274    ' Muted green
Private Const COLOR_OWNER3 As Long = 10053222   ' Soft orange
Private Const COLOR_OWNER4 As Long = 8109667    ' Purple
Private Const COLOR_MILESTONE As Long = 255      ' Red
Private Const COLOR_COMPLETE As Long = 5287936  ' Dark green for progress bar

' === Module-Level Variables ===
Private mWsDat As Worksheet
Private mWsGantt As Worksheet
Private mWsCfg As Worksheet
Private mStartDate As Date
Private mEndDate As Date
Private mTotalDays As Long
Private mOwnerColors As Object   ' Dictionary: Owner name -> color

The Master Entry Point

Public Sub BuildGantt()
    
    Dim t As Single
    t = Timer
    
    ' --- Suppress screen flicker and speed up rendering ---
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    On Error GoTo CleanUp
    
    ' --- Initialize worksheet references ---
    Set mWsDat = ThisWorkbook.Worksheets(DATA_SHEET)
    Set mWsGantt = ThisWorkbook.Worksheets(CHART_SHEET)
    Set mWsCfg = ThisWorkbook.Worksheets(CONFIG_SHEET)
    
    ' --- Read config parameters ---
    mStartDate = mWsCfg.Range("cfg_StartDate").Value
    mEndDate = mWsCfg.Range("cfg_EndDate").Value
    mTotalDays = mEndDate - mStartDate + 1
    
    ' --- Validate inputs ---
    If mEndDate <= mStartDate Then
        MsgBox "cfg_EndDate must be after cfg_StartDate.", vbCritical, "Gantt Error"
        GoTo CleanUp
    End If
    
    If mTotalDays > 365 Then
        If MsgBox("Timeline spans " & mTotalDays & " days. This may be slow. Continue?", _
                  vbYesNo + vbQuestion) = vbNo Then GoTo CleanUp
    End If
    
    ' --- Build owner color dictionary ---
    BuildOwnerColorMap
    
    ' --- Clear and reset the Gantt sheet ---
    ClearGanttSheet
    
    ' --- Render each layer ---
    RenderHeaders
    RenderTaskRows
    ApplyConditionalFormatting
    DrawShapeBars
    
    ' --- Final polish ---
    mWsGantt.Activate
    mWsGantt.Range("A1").Select
    
    MsgBox "Gantt chart built in " & Format(Timer - t, "0.00") & " seconds.", _
           vbInformation, "Complete"

CleanUp:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Gantt Error"
    End If

End Sub

The On Error GoTo CleanUp pattern here is critical. Shape manipulation and conditional formatting can fail in unexpected ways, and if your error handler doesn't restore ScreenUpdating and Calculation, Excel will appear frozen to the user. See Error Handling and Debugging VBA Code Like a Pro for a deeper treatment of this pattern.

---

Clearing and Resetting the Canvas

Every rebuild starts with a clean slate. This is important — partial renders are worse than no renders.

Private Sub ClearGanttSheet()
    
    With mWsGantt
        ' Remove all shapes (task bars, milestones)
        Dim shp As Shape
        For Each shp In .Shapes
            If shp.Type <> msoFormControl Then shp.Delete  ' Preserve buttons
        Next shp
        
        ' Clear all conditional formatting
        .Cells.FormatConditions.Delete
        
        ' Clear content and formatting from data area
        .Cells.ClearContents
        .Cells.Interior.ColorIndex = xlNone
        .Cells.Borders.LineStyle = xlNone
        .Cells.Font.Bold = False
        
        ' Reset row and column dimensions
        .Rows.RowHeight = mWsCfg.Range("cfg_RowHeight").Value
        .Columns.ColumnWidth = 8.43  ' Default width first
    End With
    
End Sub

---

Rendering the Date Headers

The header section spans three rows: month names (merged across their days), week numbers, and individual day numbers. This is the visual backbone of the timeline.

Private Sub RenderHeaders()
    
    Dim ws As Worksheet
    Set ws = mWsGantt
    
    Dim colWidth As Double
    colWidth = mWsCfg.Range("cfg_ColWidth").Value / 10  ' Convert to Excel column width units
    
    ' --- Set up left-side task info columns ---
    ws.Columns("A").ColumnWidth = 6    ' Task ID
    ws.Columns("B").ColumnWidth = 14   ' Phase
    ws.Columns("C").ColumnWidth = 28   ' Task Name
    ws.Columns("D").ColumnWidth = 14   ' Owner
    
    ' --- Write column headers for task info ---
    With ws
        .Cells(3, 1).Value = "ID"
        .Cells(3, 2).Value = "Phase"
        .Cells(3, 3).Value = "Task"
        .Cells(3, 4).Value = "Owner"
    End With
    
    ' --- Render date columns ---
    Dim d As Date
    Dim col As Long
    Dim currentMonth As Integer
    Dim monthStartCol As Long
    Dim prevMonth As Integer
    
    currentMonth = 0
    monthStartCol = GANTT_DATA_START_COL
    
    For d = mStartDate To mEndDate
        col = GANTT_DATA_START_COL + (d - mStartDate)
        
        ' Set column width for date columns
        ws.Columns(col).ColumnWidth = colWidth
        
        ' Row 1: Month name (we'll merge after the loop)
        If Month(d) <> currentMonth Then
            If currentMonth <> 0 Then
                ' Merge the previous month range
                MergeAndFormatMonthHeader ws, monthStartCol, col - 1, _
                    MonthName(currentMonth, False) & " " & Year(d - 1)
            End If
            currentMonth = Month(d)
            monthStartCol = col
        End If
        
        ' Row 2: Week number (ISO week)
        Dim wkNum As Integer
        wkNum = DatePart("ww", d, vbMonday, vbFirstFourDays)
        ws.Cells(2, col).Value = "W" & wkNum
        
        ' Row 3: Day number, color weekends
        ws.Cells(3, col).Value = Day(d)
        If Weekday(d, vbMonday) >= 6 Then  ' Saturday or Sunday
            ws.Cells(3, col).Interior.Color = RGB(220, 220, 220)
            ws.Cells(2, col).Interior.Color = RGB(220, 220, 220)
        End If
        
    Next d
    
    ' Close out the last month header
    MergeAndFormatMonthHeader ws, monthStartCol, col, _
        MonthName(currentMonth, False) & " " & Year(mEndDate)
    
    ' --- Format the header rows ---
    With ws.Rows("1:3")
        .Font.Bold = True
        .Font.Size = 9
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    ' Freeze panes below header, right of task info columns
    ws.Activate
    ws.Cells(GANTT_DATA_START_ROW, GANTT_DATA_START_COL).Select
    ActiveWindow.FreezePanes = False
    ActiveWindow.FreezePanes = True
    
End Sub

Private Sub MergeAndFormatMonthHeader(ws As Worksheet, startCol As Long, _
                                       endCol As Long, caption As String)
    With ws.Range(ws.Cells(1, startCol), ws.Cells(1, endCol))
        .Merge
        .Value = caption
        .Interior.Color = RGB(31, 73, 125)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
        .Font.Size = 10
        .HorizontalAlignment = xlCenter
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Color = RGB(255, 255, 255)
    End With
End Sub

---

Rendering Task Rows

Now we populate the left-side task info and lay down the grid for each task row.

Private Sub RenderTaskRows()
    
    Dim wsDat As Worksheet
    Dim wsGantt As Worksheet
    Set wsDat = mWsDat
    Set wsGantt = mWsGantt
    
    ' Find last row in data sheet
    Dim lastDataRow As Long
    lastDataRow = wsDat.Cells(wsDat.Rows.Count, "A").End(xlUp).Row
    
    Dim dataRow As Long
    Dim ganttRow As Long
    ganttRow = GANTT_DATA_START_ROW
    
    Dim rowHt As Double
    rowHt = mWsCfg.Range("cfg_RowHeight").Value
    
    For dataRow = FIRST_DATA_ROW To lastDataRow
        
        ' Read task data
        Dim taskID As String
        Dim phase As String
        Dim taskName As String
        Dim owner As String
        Dim startDt As Date
        Dim endDt As Date
        Dim isMilestone As Boolean
        Dim pctComplete As Double
        
        taskID = wsDat.Cells(dataRow, 1).Value
        phase = wsDat.Cells(dataRow, 2).Value
        taskName = wsDat.Cells(dataRow, 3).Value
        owner = wsDat.Cells(dataRow, 4).Value
        
        ' Skip blank rows
        If taskID = "" And taskName = "" Then GoTo NextRow
        
        startDt = wsDat.Cells(dataRow, 5).Value
        endDt = wsDat.Cells(dataRow, 6).Value
        isMilestone = (wsDat.Cells(dataRow, 7).Value = 1)
        pctComplete = wsDat.Cells(dataRow, 8).Value
        
        ' Validate dates
        If Not IsDate(startDt) Or Not IsDate(endDt) Then GoTo NextRow
        If endDt < startDt Then GoTo NextRow
        
        ' Write task info to left columns
        With wsGantt
            .Cells(ganttRow, 1).Value = taskID
            .Cells(ganttRow, 2).Value = phase
            .Cells(ganttRow, 3).Value = taskName
            .Cells(ganttRow, 4).Value = owner
            
            ' Style the task row
            .Rows(ganttRow).RowHeight = rowHt
            .Cells(ganttRow, 3).Font.Bold = True
            
            ' Zebra stripe for readability
            If (ganttRow Mod 2) = 0 Then
                .Range(.Cells(ganttRow, 1), .Cells(ganttRow, 4)).Interior.Color = RGB(242, 242, 242)
            End If
            
            ' Light grid lines across the date columns
            Dim dateRangeEnd As Long
            dateRangeEnd = GANTT_DATA_START_COL + mTotalDays - 1
            .Range(.Cells(ganttRow, GANTT_DATA_START_COL), _
                   .Cells(ganttRow, dateRangeEnd)).Interior.Color = RGB(250, 250, 250)
        End With
        
        ' Store the row number for use by DrawShapeBars (we tag the row with the data row index)
        wsGantt.Cells(ganttRow, 1).Comment.Delete  ' Clear if exists
        ' We use a hidden column to store task metadata for DrawShapeBars
        ' Column E on GanttChart temporarily stores startDt, endDt, isMilestone, pctComplete
        ' We'll use a separate metadata range approach below
        StoreTaskMetadata wsGantt, ganttRow, startDt, endDt, isMilestone, pctComplete, owner

        ganttRow = ganttRow + 1
        
NextRow:
    Next dataRow
    
    ' Store total rendered row count for other procedures
    mWsCfg.Range("cfg_LastGanttRow").Value = ganttRow - 1
    
End Sub

Private Sub StoreTaskMetadata(ws As Worksheet, ganttRow As Long, _
                               startDt As Date, endDt As Date, _
                               isMilestone As Boolean, pctComplete As Double, _
                               owner As String)
    ' We use a hidden area to the far right to store rendering metadata
    ' This avoids double-looping through the data sheet in DrawShapeBars
    Dim metaCol As Long
    metaCol = GANTT_DATA_START_COL + mTotalDays + 2  ' Two columns past the chart area
    
    ws.Cells(ganttRow, metaCol).Value = startDt
    ws.Cells(ganttRow, metaCol + 1).Value = endDt
    ws.Cells(ganttRow, metaCol + 2).Value = IIf(isMilestone, 1, 0)
    ws.Cells(ganttRow, metaCol + 3).Value = pctComplete
    ws.Cells(ganttRow, metaCol + 4).Value = owner
    
    ' Hide the metadata columns
    ws.Columns(metaCol).Hidden = True
    ws.Columns(metaCol + 1).Hidden = True
    ws.Columns(metaCol + 2).Hidden = True
    ws.Columns(metaCol + 3).Hidden = True
    ws.Columns(metaCol + 4).Hidden = True
End Sub

---

Applying Conditional Formatting for the Grid

Conditional formatting handles the "live" visual layer — things that should update automatically when dates change without needing a full rebuild. We'll add CF rules that highlight today's date column and shade weekend columns.

Private Sub ApplyConditionalFormatting()
    
    Dim ws As Worksheet
    Set ws = mWsGantt
    
    Dim lastGanttRow As Long
    lastGanttRow = mWsCfg.Range("cfg_LastGanttRow").Value
    
    Dim firstDateCol As Long
    firstDateCol = GANTT_DATA_START_COL
    Dim lastDateCol As Long
    lastDateCol = firstDateCol + mTotalDays - 1
    
    ' Define the full chart data range (task rows, date columns only)
    Dim chartRange As Range
    Set chartRange = ws.Range(ws.Cells(GANTT_DATA_START_ROW, firstDateCol), _
                              ws.Cells(lastGanttRow, lastDateCol))
    
    ' Clear existing CF on this range
    chartRange.FormatConditions.Delete
    
    ' --- Rule 1: Highlight today's column ---
    ' We use a formula-based rule anchored to row 3 (where day numbers live)
    ' The formula checks if the header row matches today
    Dim todayRule As FormatCondition
    Set todayRule = chartRange.FormatConditions.Add( _
        Type:=xlExpression, _
        Formula1:="=ROW(E$3)=ROW($3:$3)*AND(E$3=DAY(TODAY()),E$2=""W""&TEXT(TODAY(),""ww""))")
    
    ' Actually, a more reliable approach: use the date stored in a helper row
    ' Delete the above and use column-header matching
    chartRange.FormatConditions.Delete
    
    ' We'll write today's date offset as a named range for CF to reference
    Dim todayOffset As Long
    If Date >= mStartDate And Date <= mEndDate Then
        todayOffset = Date - mStartDate
        mWsCfg.Range("cfg_TodayCol").Value = firstDateCol + todayOffset
    Else
        mWsCfg.Range("cfg_TodayCol").Value = 0
    End If
    
    ' Rule 1: Today column highlight (using column() reference)
    Dim fc1 As FormatCondition
    Set fc1 = chartRange.FormatConditions.Add( _
        Type:=xlExpression, _
        Formula1:="=COLUMN()=cfg_TodayCol")
    fc1.Interior.Color = RGB(255, 235, 156)   ' Soft amber
    fc1.Interior.PatternColorIndex = xlAutomatic
    fc1.StopIfTrue = False
    
    ' Rule 2: Weekend columns (lighter shade)
    Dim fc2 As FormatCondition
    Set fc2 = chartRange.FormatConditions.Add( _
        Type:=xlExpression, _
        Formula1:="=WEEKDAY(cfg_StartDate+COLUMN()-" & firstDateCol & ",2)>=6")
    fc2.Interior.Color = RGB(235, 235, 235)
    fc2.StopIfTrue = False
    
    ' Rule 3: Past dates get a very subtle tint
    Dim fc3 As FormatCondition
    Set fc3 = chartRange.FormatConditions.Add( _
        Type:=xlExpression, _
        Formula1:="=(cfg_StartDate+COLUMN()-" & firstDateCol & ")<TODAY()")
    fc3.Interior.Color = RGB(248, 248, 248)
    fc3.StopIfTrue = False
    
    ' Reorder: today highlight should fire last (highest priority = lowest index in CF stack)
    chartRange.FormatConditions(1).ModifyAppliesToRange chartRange
    
    Debug.Print "CF rules applied: " & chartRange.FormatConditions.Count
    
End Sub

---

Drawing Shape-Based Task Bars

This is where the real power comes in. Shapes give you pixel-level control over bar appearance, progress indicators, and milestone diamonds — things conditional formatting simply can't do.

Private Sub DrawShapeBars()
    
    Dim ws As Worksheet
    Set ws = mWsGantt
    
    Dim lastGanttRow As Long
    lastGanttRow = mWsCfg.Range("cfg_LastGanttRow").Value
    
    Dim firstDateCol As Long
    firstDateCol = GANTT_DATA_START_COL
    Dim metaCol As Long
    metaCol = firstDateCol + mTotalDays + 2
    
    Dim ganttRow As Long
    
    For ganttRow = GANTT_DATA_START_ROW To lastGanttRow
        
        ' Read metadata stored by RenderTaskRows
        Dim startDt As Date
        Dim endDt As Date
        Dim isMilestone As Boolean
        Dim pctComplete As Double
        Dim owner As String
        
        Dim metaStart As Variant
        metaStart = ws.Cells(ganttRow, metaCol).Value
        If metaStart = "" Then GoTo NextShapeRow
        
        startDt = CDate(metaStart)
        endDt = CDate(ws.Cells(ganttRow, metaCol + 1).Value)
        isMilestone = (ws.Cells(ganttRow, metaCol + 2).Value = 1)
        pctComplete = ws.Cells(ganttRow, metaCol + 3).Value
        owner = ws.Cells(ganttRow, metaCol + 4).Value
        
        ' Calculate pixel position of the bar
        Dim barLeft As Double
        Dim barWidth As Double
        Dim barTop As Double
        Dim barHeight As Double
        
        ' Clamp dates to chart range
        Dim clampedStart As Date
        Dim clampedEnd As Date
        clampedStart = IIf(startDt < mStartDate, mStartDate, startDt)
        clampedEnd = IIf(endDt > mEndDate, mEndDate, endDt)
        
        If clampedStart > mEndDate Or clampedEnd < mStartDate Then GoTo NextShapeRow
        
        ' Get left position: sum widths of columns to the left of the bar start
        Dim startCol As Long
        startCol = firstDateCol + (clampedStart - mStartDate)
        barLeft = GetColumnLeft(ws, startCol)
        
        ' Get width: sum widths of all columns covered by the task
        Dim endCol As Long
        endCol = firstDateCol + (clampedEnd - mStartDate)
        barWidth = GetColumnLeft(ws, endCol + 1) - barLeft
        
        ' Get top and height from the row
        barTop = ws.Rows(ganttRow).Top + (ws.Rows(ganttRow).Height * 0.15)
        barHeight = ws.Rows(ganttRow).Height * 0.7
        
        ' Determine bar color based on owner
        Dim barColor As Long
        barColor = GetOwnerColor(owner)
        
        If isMilestone Then
            DrawMilestoneDiamond ws, ganttRow, startCol, barTop, barHeight, barColor
        Else
            DrawTaskBar ws, ganttRow, barLeft, barWidth, barTop, barHeight, _
                        barColor, pctComplete
        End If
        
NextShapeRow:
    Next ganttRow
    
End Sub

' --- Helper: Get the Left pixel position of a column ---
Private Function GetColumnLeft(ws As Worksheet, col As Long) As Double
    Dim i As Long
    Dim totalLeft As Double
    totalLeft = 0
    For i = 1 To col - 1
        totalLeft = totalLeft + ws.Columns(i).Width * 7.5  ' Approximate points-to-pixels
    Next i
    GetColumnLeft = totalLeft
End Function

Let's rewrite the position calculation using the correct approach:

Private Sub DrawTaskBar(ws As Worksheet, ganttRow As Long, _
                         barLeft As Double, barWidth As Double, _
                         barTop As Double, barHeight As Double, _
                         barColor As Long, pctComplete As Double)
    
    ' Draw the background (incomplete) bar
    Dim bgBar As Shape
    Set bgBar = ws.Shapes.AddShape(msoShapeRoundedRectangle, _
                                    barLeft, barTop, barWidth, barHeight)
    
    With bgBar
        .Name = "Bar_Row" & ganttRow & "_BG"
        .Fill.ForeColor.RGB = BlendColor(barColor, RGB(255, 255, 255), 0.4)  ' Lighter shade
        .Line.ForeColor.RGB = barColor
        .Line.Weight = 1
        .Line.Visible = msoTrue
        .Adjustments(1) = 0.2  ' Subtle rounding
        .TextFrame.Characters.Text = ""
        .Placement = xlMoveAndSize
    End With
    
    ' Draw the progress fill bar (if any progress)
    If pctComplete > 0 And pctComplete <= 100 Then
        Dim progressWidth As Double
        progressWidth = barWidth * (pctComplete / 100)
        
        Dim progBar As Shape
        Set progBar = ws.Shapes.AddShape(msoShapeRoundedRectangle, _
                                          barLeft, barTop, progressWidth, barHeight)
        With progBar
            .Name = "Bar_Row" & ganttRow & "_Progress"
            .Fill.ForeColor.RGB = barColor
            .Fill.Transparency = 0
            .Line.Visible = msoFalse
            .Adjustments(1) = 0.2
            .TextFrame.Characters.Text = ""
            .Placement = xlMoveAndSize
        End With
    End If
    
    ' Add a percentage label if bar is wide enough
    If barWidth > 40 Then
        Dim lblBar As Shape
        Set lblBar = ws.Shapes.AddShape(msoShapeRectangle, _
                                         barLeft, barTop, barWidth, barHeight)
        With lblBar
            .Name = "Bar_Row" & ganttRow & "_Label"
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            With .TextFrame
                .Characters.Text = Format(pctComplete, "0") & "%"
                .Characters.Font.Size = 8
                .Characters.Font.Color = RGB(255, 255, 255)
                .Characters.Font.Bold = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            .Placement = xlMoveAndSize
        End With
    End If
    
End Sub

Private Sub DrawMilestoneDiamond(ws As Worksheet, ganttRow As Long, _
                                   startCol As Long, barTop As Double, _
                                   barHeight As Double, barColor As Long)
    ' Use the center of the milestone column
    Dim centerX As Double
    centerX = ws.Columns(startCol).Left + (ws.Columns(startCol).Width / 2)
    
    Dim diamondSize As Double
    diamondSize = barHeight * 0.9
    
    Dim diamond As Shape
    Set diamond = ws.Shapes.AddShape(msoShapeDiamond, _
                                      centerX - (diamondSize / 2), _
                                      barTop, _
                                      diamondSize, diamondSize)
    
    With diamond
        .Name = "Milestone_Row" & ganttRow
        .Fill.ForeColor.RGB = COLOR_MILESTONE
        .Line.ForeColor.RGB = RGB(180, 0, 0)
        .Line.Weight = 1.5
        .TextFrame.Characters.Text = ""
        .Placement = xlMoveAndSize
    End With
    
End Sub

' --- Helper: Blend two colors ---
Private Function BlendColor(color1 As Long, color2 As Long, ratio As Double) As Long
    Dim r1 As Long, g1 As Long, b1 As Long
    Dim r2 As Long, g2 As Long, b2 As Long
    
    r1 = color1 Mod 256
    g1 = (color1 \ 256) Mod 256
    b1 = (color1 \ 65536) Mod 256
    
    r2 = color2 Mod 256
    g2 = (color2 \ 256) Mod 256
    b2 = (color2 \ 65536) Mod 256
    
    BlendColor = RGB(r1 + (r2 - r1) * ratio, _
                     g1 + (g2 - g1) * ratio, _
                     b1 + (b2 - b1) * ratio)
End Function

Building the Owner Color Map

Private Sub BuildOwnerColorMap()
    Set mOwnerColors = CreateObject("Scripting.Dictionary")
    
    ' Assign colors in round-robin as we encounter new owners
    ' Pre-define a palette
    Dim palette(7) As Long
    palette(0) = RGB(70, 130, 180)    ' Steel Blue
    palette(1) = RGB(60, 179, 113)    ' Medium Sea Green
    palette(2) = RGB(255, 140, 0)     ' Dark Orange
    palette(3) = RGB(147, 112, 219)   ' Medium Purple
    palette(4) = RGB(205, 92, 92)     ' Indian Red
    palette(5) = RGB(64, 224, 208)    ' Turquoise
    palette(6) = RGB(255, 165, 0)     ' Orange
    palette(7) = RGB(176, 196, 222)   ' Light Steel Blue
    
    Dim ws As Worksheet
    Set ws = mWsDat
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim r As Long
    Dim colorIndex As Integer
    colorIndex = 0
    
    For r = FIRST_DATA_ROW To lastRow
        Dim ownerName As String
        ownerName = ws.Cells(r, 4).Value
        If ownerName <> "" And Not mOwnerColors.Exists(ownerName) Then
            mOwnerColors.Add ownerName, palette(colorIndex Mod 8)
            colorIndex = colorIndex + 1
        End If
    Next r
End Sub

Private Function GetOwnerColor(owner As String) As Long
    If mOwnerColors.Exists(owner) Then
        GetOwnerColor = mOwnerColors(owner)
    Else
        GetOwnerColor = RGB(128, 128, 128)  ' Default gray
    End If
End Function

---

Adding a Today Line

A vertical "today" line is one of those small touches that makes a Gantt chart genuinely useful in meetings. Let's add it.

Private Sub DrawTodayLine()
    
    Dim ws As Worksheet
    Set ws = mWsGantt
    
    ' Only draw if today falls within the chart range
    If Date < mStartDate Or Date > mEndDate Then Exit Sub
    
    Dim todayCol As Long
    todayCol = GANTT_DATA_START_COL + (Date - mStartDate)
    
    Dim lastGanttRow As Long
    lastGanttRow = mWsCfg.Range("cfg_LastGanttRow").Value
    
    ' Calculate vertical span
    Dim lineX As Double
    lineX = ws.Columns(todayCol).Left + (ws.Columns(todayCol).Width / 2)
    
    Dim lineTop As Double
    lineTop = ws.Rows(1).Top
    
    Dim lineBottom As Double
    lineBottom = ws.Rows(lastGanttRow).Top + ws.Rows(lastGanttRow).Height
    
    ' Draw a vertical line
    Dim todayLine As Shape
    Set todayLine = ws.Shapes.AddLine(lineX, lineTop, lineX, lineBottom)
    
    With todayLine
        .Name = "TodayLine"
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .Line.Weight = 2
        .Line.DashStyle = msoLineDashDot
    End With
    
    ' Add a "TODAY" label at the top
    Dim todayLabel As Shape
    Set todayLabel = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                           lineX - 20, lineTop, 45, 14)
    With todayLabel
        .Name = "TodayLabel"
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = "TODAY"
        .TextFrame.Characters.Font.Size = 7
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
        .TextFrame.Characters.Font.Bold = True
    End With
    
End Sub

Call DrawTodayLine at the end of DrawShapeBars so it layers on top of the task bars.

---

Wiring in an Event-Driven Refresh

For real production use, you want the chart to auto-refresh when users change data. Add this to the ProjectData sheet module (not the general module):

' In the ProjectData sheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    ' Only trigger if changes are in the task data area (rows 2+, columns A-H)
    If Target.Row < 2 Then Exit Sub
    If Target.Column > 8 Then Exit Sub
    
    ' Debounce: don't rebuild on every single keystroke
    ' Use Application.OnTime to delay the rebuild by 1 second
    Application.OnTime Now + TimeValue("00:00:01"), "GanttEngine.BuildGantt"
    
End Sub

---

Hands-On Exercise

Now it's your turn to extend the engine. Here's a realistic project to build on top of what we've covered:

The challenge: Add a "Phase Banner" feature that draws a colored banner spanning all tasks within the same phase, rendered one row above the first task in that phase.

What you'll need to do:

1. After RenderTaskRows completes, scan the GanttChart sheet to identify groups of consecutive rows with the same Phase value (column B).
2. For each phase group, identify the earliest start date and latest end date across all tasks in that phase.
3. Draw a Shape rectangle spanning those dates, one row above the first task row in the group, with the phase name as a label.
4. Color the banner using a separate phase color palette (not the owner palette).

Extension: Add a button on the GanttChart sheet that calls BuildGantt and a second button that exports the chart area as a PNG using ws.ExportAsFixedFormat or the ChartObject capture technique.

---

Common Mistakes & Troubleshooting

"The shape bars don't line up with the date columns"

This is almost always a column width unit problem. Excel column widths are not in pixels or points — they're in character units based on the default font. Always use ws.Columns(col).Left and ws.Rows(row).Top to get actual point-based positions for Shape placement. Never calculate these yourself from column width numbers.

"Conditional formatting rules multiply on every rebuild"

If you forget to call chartRange.FormatConditions.Delete before adding new rules, each rebuild stacks more CF rules on the range. Fifty rebuilds later, you've got 150+ CF rules and Excel is crawling. Always clear CF before re-applying. See Excel Performance Optimization: Fix Slow Workbooks for a broader look at this class of issue.

"Shapes get left behind after a rebuild"

The ClearGanttSheet procedure deletes shapes with shp.Type <> msoFormControl. If you've added buttons (FormControls) to the sheet, they're preserved. But if you accidentally created shapes with Type = msoFormControl, they get protected too. Name all your engine-generated shapes with a consistent prefix (e.g., "Bar_", "Milestone_", "TodayLine") and delete by name prefix rather than type:

Dim shp As Shape
For Each shp In ws.Shapes
    If Left(shp.Name, 4) = "Bar_" Or _
       Left(shp.Name, 9) = "Milestone" Or _
       shp.Name = "TodayLine" Or _
       shp.Name = "TodayLabel" Then
        shp.Delete
    End If
Next shp

"The engine crashes when tasks extend beyond cfg_EndDate"

We clamp dates with IIf(endDt > mEndDate, mEndDate, endDt) in DrawShapeBars, but if clampedStart > mEndDate after clamping, we GoTo NextShapeRow. Make sure both sides of the clamp are applied and validated before calculating column positions.

"Performance is terrible with 100+ tasks and a 6-month timeline"

A 6-month timeline is ~180 columns. For 100 tasks, that's 18,000 cells in the chart area — manageable, but CF on all of them plus 300+ shapes can get slow. Key optimizations:

• Set Application.ScreenUpdating = False early (our engine already does this)
• Avoid Select and Activate — we never use them in shape drawing
• Batch CF rules by applying to the entire range at once, not row by row
• Consider using xlMoveAndSize placement for shapes instead of xlFreeFloating — it's faster to render

---

Summary & Next Steps

You've built a complete Gantt chart engine that generates headers dynamically, renders task bars using Shape automation, applies layered conditional formatting for visual context, and draws milestone markers — all driven from a clean data model with a single macro entry point.

The architecture is genuinely production-ready: clean separation between data and rendering, a config sheet for parameters, named ranges for maintainability, error handling that always restores Excel's state, and an event-driven refresh mechanism.

Where to take this next:

• Add a UserForm for task entry — instead of editing the ProjectData sheet directly, build a form that validates dates and inserts rows. Building UserForms for Custom Data Entry Interfaces walks you through that pattern.

• Export to PDF on a schedule — combine the Gantt engine with scheduled execution from Scheduling and Running VBA Macros Automatically with Windows Task Scheduler and Application.OnTime to auto-publish weekly status charts.

• Pull task data from an external database — replace the static ProjectData sheet with a live ADO query. Connecting Excel to External Databases with VBA covers the full connection pattern.

• Package it as an add-in — wrap the engine in a ribbon button and deploy it across your team using Building Excel Add-Ins with VBA: Package and Deploy Custom Tools Across Your Organization.

The Gantt engine pattern — read data, compute layout, render visuals, apply formatting — generalizes to almost any complex Excel visualization. Once you've internalized this approach, you'll see dozens of places to apply it.