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