Color Gantt Chart with RGB colours instead of index colors

[Stefan_Sand]

Hello,

i made a nice and as i thought, very elegant array macro some years ago to give a gantt chart index colours (3, 45, 4) linked to its status information. What i tried in vain was to replace the index colours with RGB colurs of Status cells (please see my example) and to insert some columns with other information, but no impact to the coloring of the gantt chart . Is there an easy way to replace index colours wit the RGB value of a given status array (in this case 8 colours)? Can you help me?

[HansV]

Instead of using

Code: Select all

  Selection.Interior.ColorIndex = Farbe

you can use

Code: Select all

  Selection.Interior.Color = ...

where ... is an RGB color.
Even better, replace

Code: Select all

  ActiveSheet.ChartObjects("Diagramm 8").Activate
  ActiveChart.SeriesCollection(2).Points(z).Select
  Selection.Interior.ColorIndex = Farbe

with

Code: Select all

  ActiveSheet.ChartObjects("Diagramm 8").Chart.SeriesCollection(2).Points(z).Interior.Color = ...

[Stefan_Sand]

ok, but how can i take the RGB array colours (in this case now in worksheet Plan in cells G4:G11)?

[HansV]

Try this:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c1 As Range
    Dim c2 As Range
    If Not Intersect(Range("E4:E15"), Target) Is Nothing Then
        For Each c1 In Intersect(Range("E4:E15"), Target)
            Set c2 = Range("G4:G11").Find(What:=c1.Value, LookAt:=xlWhole)
            If c2 Is Nothing Then
                c1.Interior.ColorIndex = xlColorIndexNone
            Else
                c1.Interior.Color = c2.Interior.Color
            End If
        Next c1
    End If
End Sub

Note: cell G6 has a theme color instead of an RGB color. Better assign an RGB color to G6, otherwise the colors won't match.

[Stefan_Sand]

ok, now it changes the cell color, i will test it so to change the chart colors as well

[HansV]

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c1 As Range
    Dim c2 As Range
    Dim z As Long
    If Not Intersect(Range("E4:E15"), Target) Is Nothing Then
        For Each c1 In Intersect(Range("E4:E15"), Target)
            z = c1.Row - 3
            Set c2 = Range("G4:G11").Find(What:=c1.Value, LookAt:=xlWhole)
            If c2 Is Nothing Then
                c1.Interior.ColorIndex = xlColorIndexNone
                Me.ChartObjects("Diagramm 8").Chart.SeriesCollection(2) _
                    .Points(z).Interior.ColorIndex = xlColorIndexNone
            Else
                c1.Interior.Color = c2.Interior.Color
                Me.ChartObjects("Diagramm 8").Chart.SeriesCollection(2) _
                    .Points(z).Interior.Color = c2.Interior.Color
            End If
        Next c1
    End If
End Sub

[Stefan_Sand]

cool, thank you, Hans.