Link Column's color in a chart to a range in the worksheet

Question

I have a range next to data area of the column-chart. I have to relate each column's color of the chart with this range. Eg if there is "X" in the table, so the chart-column ralated to this row would be red, else green.

I have written something like this here below, but it doesn't work. On the other hand VBA doesn't discard this code :)

Data column begins in E2 and chart's columns are Point(1), ...(2) etc.

Sub Chart_Color()

Worksheets("Sheet1").ChartObjects("Chart 1").Activate 'sheet's name
ActiveChart.FullSeriesCollection(1).Select

LineNum = Worksheets("Sheet1").Rows.Count
For i = 1 To LineNum
i = i + 1
If Worksheets("Sheet1").Range("E:E").Cells(i + 1).Value = "X" Then
ActiveChart.FullSeriesCollection(1).Points(i).Select
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
    .Solid
End With
Else
With Selection.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 255, 0)
    .Transparency = 0
    .Solid
End With
End If
Next i
End Sub

Answer 1

Now it works :)

Sub chart_color()

Application.ScreenUpdating = False

Dim Cell As Range
Dim i As Byte

For i = 0 To 100
For Each Cell In Worksheets("Sheet1").Range("E1").Offset(i, 0)

If Cell.Value = "X" Then
Worksheets("Ma").ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
End If
If Cell.Value = "Y" Then
Worksheets("Ma").ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
If Cell.Value = "Z" Then
Worksheets("Ma").ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(0, 255, 0)
End If

Next Cell
Next i

End Sub

Answer 2

On the presumption that your above code works, which I can't test (in part because I don't have Office 365), the code below should work more efficiently.

Dim ColorId As Long
Dim LastRow As Long
Dim R As Long                           ' row number
Dim i As Long


Application.ScreenUpdating = False
With Worksheets("Sheet1")
    LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
    For R = 2 To LastRow                ' start in row 2
        ColorId = InStr(1, "XYZ", Trim(.Cells(R, "E").Value), vbTextCompare)
        If ColorId Then
            ColorId = Array(vbRed, vbGreen, vbBlue)(ColorId - 1)
            With Worksheets("Ma").ChartObjects("Chart 1").FullSeriesCollection(R - 1)
                For i = 1 To .Points.Count
                    .Points(i).Format.Fill.ForeColor = ColorId
                Next i
            End With
        End If
    Next R
End With

In case it doesn't work you might like to lift the loop construction from it. Your loop includes many thousands of cells which aren't required. The other thing I urge you to consider is my attempt to do without activating or selecting anything. I know it is possible, I know that doing so is better, but I might not quite have found the correct syntax to address the FullSeriesCollection. This I have borrowed and transscribed from your own code.

If vbRed, vbGreen and vbBlue doesn't work for you the following code can replace these values. Place it at the top of the above code, just under Dim R As Long , except for the last line which must replace the similar line of code in the middle of the procedure.

Dim myRed As Long, myGreen As Long, myBlue As Long

myRed = RGB(0, 0, 255)
myGreen = RGB(255, 255, 0)
myBlue = RGB(0, 255, 0)
Set ColorId = Array(myRed, myGreen, myBlue)(ColorId - 1)

Answer 3

We are now looking at this portion of my code which you find that it doesn't work (sorry, I can't test).

ColorId = vbRed            ' ColorId is a Long
i = 1
Worksheets("Ma").ChartObjects("Chart 1").FullSeriesCollection(1) _
                            .Points(i).Format.Fill.ForeColor = ColorId

This is supposed to be the equivalent of your code of which you say that it does work.

i = 1
Worksheets("Ma").ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0)

Let's forget about the value of i for the moment. The value of 1 which I assign to it is arbitrary.

I tested both .Fill.ForeColor = ColorId and .Fill.ForeColor.RGB = ColorId on a shape object and they both work. Therefore it should be possible to simply replace my 1 1/2 lines of code with your two lines of code and replace `RGB(255, 255, 0)' with 'ColorId'. You may also have to activate (Select) Worksheets("Ma") before you can activate a chart in it.

I studied both the SeriesCollection and Points methods and will therefore amend my above code to improve the referencing of both which may open new sources of error. Are you sure you need to format the points? My instinct is to try and set the colour like this:-

Worksheets("Ma").ChartObjects(1).Chart.SeriesCollection(1) _
                .Interior.Color = ColorId

Replace SeriesCollection with FullSeriesCollection only if you do filtering.