Do you have a friendly name? I like to address people by their first name if
possible.

Assuming my assumptions were correct the following should do what you want.

Note it is hardcoded to use Sheet1 as the source sheet and Sheet 2 as the
Target sheet. (but those, and the colour definitions can be altered in theiir
respective lines after the Dims.

I do not think it is necessarily the most efficient way to do this and it does
not allow for tracking other han manually. I did develop a good tracking
Gantt in either excel  or access years ago. If you want I will try to find it.
It uses shapes placed on the sheet as drawing objects rather than coloured
cells.

When you use it watch out for lines that have been split by the email programs
and join them. There should not be many.

If you want any more info get back to the list.

*** START code  ***


Sub GenerateGantt()

Dim J
Dim strProject As String
Dim strCurrproject As String
Dim strStage As String
Dim intStart As Integer
Dim intDuration As Integer

Dim wksSourceSheet As Worksheet
Dim wksTargetSheet As Worksheet
Dim lngSourceRowNumber As Long
Dim lngTargetRowNumber As Long
Dim LastRow As Long

Dim ColorDesign As Long

Dim ColorInstHwr As Long
Dim ColorInstSwr As Long
Dim ColorConfig As Long
Dim ColorPrep As Long
Dim ColorSupport As Long

Dim ActionColor As Long

ColorDesign = RGB(255, 0, 0) 'red
ColorInstHwr = RGB(0, 0, 255) 'blue
ColorInstSwr = RGB(0, 255, 0) 'Green
ColorConfig = RGB(255, 128, 128) 'Pink
ColorPrep = RGB(255, 255, 0) 'Yellow
ColorSupport = RGB(0, 0, 0) 'Black

Set wksSourceSheet = ActiveWorkbook.Sheets("Sheet1")
Set wksTargetSheet = ActiveWorkbook.Sheets("Sheet2")



'Find end of data
wksSourceSheet.Activate
wksSourceSheet.Range("A65536").Select
LastRow = Selection.End(xlUp).Row



lngTargetRowNumber = 2
strCurrproject = ""
lngSourceRowNumber = 2
Do While lngSourceRowNumber < LastRow
lngSourceRowNumber = lngSourceRowNumber + 1
If wksSourceSheet.Range("a" & lngSourceRowNumber).Value <> "" Then
With wksSourceSheet
strProject = .Range("A" & lngSourceRowNumber).Value
strStage = .Range("B" & lngSourceRowNumber).Value
intStart = .Range("C" & lngSourceRowNumber).Value
intDuration = .Range("D" & lngSourceRowNumber).Value

End With
With wksTargetSheet
If strProject <> strCurrproject Then
strCurrproject = strProject
lngTargetRowNumber = lngTargetRowNumber + 1
.Range("A" & lngTargetRowNumber).Value = strProject
End If
Select Case strStage
Case "Design"
ActionColor = ColorDesign
Case "Install Hardware"
ActionColor = ColorInstHwr
Case "Install Software"
ActionColor = ColorInstSwr
Case "Configure"
ActionColor = ColorConfig
Case "Prep"
ActionColor = ColorPrep
Case "Support"
ActionColor = ColorSupport
Case Else
MsgBox "Unrecognised stage"
Exit Sub
End Select
For J = intStart + 1 To intStart + intDuration
.Cells(lngTargetRowNumber, J).Interior.Color = ActionColor
Next J
End With
End If
Loop

wksTargetSheet.Activate


End Sub