Color Chart Data Points By Cell Color

Hello, I'm looking for a way to color the chart data by cell color or RGB values in a cell.

I don't know VBA, can this be done?

I found a thread at another forum where a guy posted macro to do this, but I can't seem to find it, just a bunch of vba to put labels on chart etc.
Thre thread is very old and I don't think I get reply from him, any ideas. Am I blind and don't see the macro?

http://www.ozgrid.com/forum/showthre...566#post370566

Originally Posted by Andy Pope

The code is in the worksheet object, rather than a standard code module, because it is run when the selection_change event fires.

OK, I found the code placed it into a button, but the code will not run. I have attached my file.

Sub Button1_Click()
Option Explicit
Dim i, j, k, o, NumofCore, r, s, p As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim strName As String
    Dim rngTemp As Range
    Dim sc As Series
    Dim ch As ChartObject
     
    Application.ScreenUpdating = False
    
    strName = "'" & Target.Parent.Name & "'!lastcell"
    
    With ActiveWorkbook
        On Error Resume Next
        Set rngTemp = .Names(strName).RefersToRange
        On Error GoTo 0
        If Not rngTemp Is Nothing Then
            .Names(strName).RefersTo = "='" & Target.Parent.Name & "'!" & Target.Address
        Else
            .Names.Add Name:=strName, RefersTo:="='" & Target.Parent.Name & "'!" & Target.Address
        End If
    End With


    On Error Resume Next
    For Each ch In ActiveSheet.ChartObjects
        ch.Activate
        o = rngTemp.Row
        p = Target.Row
        If o >= 15 And o <= 14 + 10 Then
            For Each sc In ActiveChart.SeriesCollection
                If p > 14 + Sheets.Count - 2 Or p < 15 Then
                    If Cells(o + 1, 3) <> "" Then
                        s = sc.Points(o + 1 - 14).MarkerBackgroundColorIndex
                    Else
                        s = sc.Points(o - 1 - 14).MarkerBackgroundColorIndex
                    End If
                Else
                    s = sc.Points(p - 14).MarkerBackgroundColorIndex
                End If
                sc.Points(o - 14).MarkerBackgroundColorIndex = s
            Next
        End If
        If p >= 15 And p <= 14 + 10 Then
            For Each sc In ActiveChart.SeriesCollection
                k = sc.Points(p - 14).MarkerBackgroundColorIndex
                If k <> 11 Then
                    sc.Points(p - 14).MarkerBackgroundColorIndex = 11
                End If
            Next
        End If
    Next
    
    ActiveWindow.Visible = False
    ActiveCell.Select
    
End Sub


End Sub

Thank you, it works perfect.
The range in the code can be changed if I need to color from different cells right.

If a graph would contain multiple series, say 2 for example. Is it possible to choose what colors are used for what series, to be able to paint them separately?

Your code works fine, but I wanted to have 2 different color ranges, separate for each series in the chart.
Please see the attached xls file, I wanted to have an easy way to change, add series that is why i call next piece of code like this.
Can you make this work?

Originally Posted by Andy Pope

There are two separate ranges being used for each series.
First series uses D8:D27 then the second series uses the OFFSET function to redefine the colors to come from range G8:G27.

I simply copied the 3 columns of data and altered the xy values. I did not bother to change the colours being used in G8:G27. If you chaneg those and re run the code you will see the difference.

Then your code does not work, to make sure I changed range G8:G27 colors to single color and yet they were colored with various colors.

Here is my code, could you make it work? I don't like offsets it's hard to use when sheet size is large.

' Paints series 1 with color range 1
Sub Paint_series1()
     
    Dim rngColors As Range
    Dim rngCell As Range
    Dim lngPoint As Long
    
    Set rngColors = ActiveSheet.Range("D8:D27")
    
    With ActiveSheet.ChartObjects(1).Chart
        With .SeriesCollection(1)
            lngPoint = 1
            For Each rngCell In rngColors.Cells
                .Points(lngPoint).MarkerBackgroundColorIndex = rngCell.Interior.ColorIndex
                lngPoint = lngPoint + 1
            Next
        End With
    End With
Call Paint_series2
End Sub
' Paints series 2 with color range 2
Sub Paint_series2()
     
    Dim rngColors As Range
    Dim rngCell As Range
    Dim lngPoint As Long
    
    Set rngColors = ActiveSheet.Range("G8:G27")
    
    With ActiveSheet.ChartObjects(1).Chart
        With .SeriesCollection(1)
            lngPoint = 1
            For Each rngCell In rngColors.Cells
                .Points(lngPoint).MarkerBackgroundColorIndex = rngCell.Interior.ColorIndex
                lngPoint = lngPoint + 1
            Next
        End With
    End With
End Sub

The both codes works OK now. Thank you.

What's the sheet size got to do with using offset in this case?

The offset is static and once the sheet size is large it's very hard to recalculate (count cells to the righ, left etc.) it again if a rows or columns are inseted to the worksheet.

I have used some offset pieces of code to convert the cells to RGB because I was told that the fuctions does not handle ranges from separate sheets. It was nightmare to keep the code working after I had to add some rows and colums to acomodate aditional data.

Can't the code be changed to take data from range, and paint a range too?
Code takes RGB values from sheet LAB2RGB!F8:F27
Paints a range in antoher sheet Color_No with offset is it possible to make it a range instead?

Sub Color_No_reference1_20()
    Dim cell        As Range

    For Each cell In Range("LAB2RGB!F8:F27").Cells
        With cell
            Worksheets("Color_No").Range(cell.Address).Interior.Color = RGB(.Offset(91, 21).Value, _
                                                                          .Offset(91, 22).Value, _
                                                                          .Offset(91, 23).Value)
        End With
    Next cell
End Sub

Thank you again, your code works perfect. I will adapt your code to my document.

I also found a bug that grayscale colors are not grayscale on the graph, why is this limitation of excel?

Yes I thought too that colorindex was a problem, because it colored some point correctly. Thanks.

It would still be nice if I could paint the chart with RGB values,
I tried to change your code but it seems I don't know what i'm doing

Sub TestColorRange()

    Dim rngRColor As Range
    Dim rngGColor As Range
    Dim rngBColor As Range
    Dim rngApplyTo As Range
    
    With Worksheets("LAB2RGB")
        Set rngRColor = .Range("A8:A27")
        Set rngGColor = .Range("B8:B27")
        Set rngBColor = .Range("C8:C27")
    End With
    
    Set rngApplyTo = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
    
    ApplyColorToCell rngRColor, rngGColor, rngBColor, rngApplyTo
        
End Sub
Sub ApplyColorToCell(RColor As Range, GColor As Range, BColor As Range, ApplyTo As Range)

    Dim lngItem As Long
    
    For lngItem = 1 To ApplyTo.Cells.Count
        ApplyTo.Points(lngItem).Interior.Color = RGB(RColor.Cells(lngItem), _
                                                    GColor.Cells(lngItem), _
                                                    BColor.Cells(lngItem))
    Next
End Sub

Here is my file with the above code, when you have time please take a look at it.
I just visited your website is great, many examples. Seems like you are Excel VBA chart expert

thank you, the code works fine now.

If painting second series what is better?

' Paints series 1 with color range 1
Sub Paint_series1()
    Dim rngRColor As Range
    Dim rngGColor As Range
    Dim rngBColor As Range
    Dim objApplyTo As Series
    
    With Worksheets("LAB2RGB")
        Set rngRColor = .Range("AA179:AA198")
        Set rngGColor = .Range("AB179:AB198")
        Set rngBColor = .Range("AC179:AC198")
    End With
    
    Set objApplyTo = Worksheets("Paper_No").ChartObjects("Chart 2").Chart.SeriesCollection(1)
    
    ApplyColorToChartSeries1 rngRColor, rngGColor, rngBColor, objApplyTo
        
End Sub
Sub ApplyColorToChartSeries1(RColor As Range, GColor As Range, BColor As Range, ApplyTo As Series)

    Dim lngItem As Long
    
    For lngItem = 1 To ApplyTo.Points.Count
        ApplyTo.Points(lngItem).MarkerBackgroundColor = _
                                                RGB(RColor.Cells(lngItem), _
                                                    GColor.Cells(lngItem), _
                                                    BColor.Cells(lngItem))
    Next
Call Paint_series2
End Sub
' Paints series 2 with color range 2
Sub Paint_series2()
    Dim rngRColor As Range
    Dim rngGColor As Range
    Dim rngBColor As Range
    Dim objApplyTo As Series
    
    With Worksheets("LAB2RGB")
        Set rngRColor = .Range("AA199:AA218")
        Set rngGColor = .Range("AB199:AB218")
        Set rngBColor = .Range("AC199:AC218")
    End With
    
    Set objApplyTo = Worksheets("Paper_No").ChartObjects("Chart 2").Chart.SeriesCollection(2)
    
    ApplyColorToChartSeries2 rngRColor, rngGColor, rngBColor, objApplyTo
        
End Sub
Sub ApplyColorToChartSeries2(RColor As Range, GColor As Range, BColor As Range, ApplyTo As Series)

    Dim lngItem As Long
    
    For lngItem = 1 To ApplyTo.Points.Count
        ApplyTo.Points(lngItem).MarkerBackgroundColor = _
                                                RGB(RColor.Cells(lngItem), _
                                                    GColor.Cells(lngItem), _
                                                    BColor.Cells(lngItem))
    Next
End Sub

or

' Paints series 1 with color range 1
Sub Paint_series1()
    Dim rngRColor As Range
    Dim rngGColor As Range
    Dim rngBColor As Range
    Dim objApplyTo As Series
    
    With Worksheets("LAB2RGB")
        Set rngRColor = .Range("AA179:AA198")
        Set rngGColor = .Range("AB179:AB198")
        Set rngBColor = .Range("AC179:AC198")
    End With
    
    Set objApplyTo = Worksheets("Paper_No").ChartObjects("Chart 2").Chart.SeriesCollection(1)
    
    ApplyColorToChartSeries rngRColor, rngGColor, rngBColor, objApplyTo
Call Paint_series2
End Sub
' Paints series 2 with color range 2
Sub Paint_series2()
    Dim rngRColor As Range
    Dim rngGColor As Range
    Dim rngBColor As Range
    Dim objApplyTo As Series
    
    With Worksheets("LAB2RGB")
        Set rngRColor = .Range("AA199:AA218")
        Set rngGColor = .Range("AB199:AB218")
        Set rngBColor = .Range("AC199:AC218")
    End With
    
    Set objApplyTo = Worksheets("Paper_No").ChartObjects("Chart 2").Chart.SeriesCollection(2)
    
    ApplyColorToChartSeries rngRColor, rngGColor, rngBColor, objApplyTo
        
End Sub
Sub ApplyColorToChartSeries(RColor As Range, GColor As Range, BColor As Range, ApplyTo As Series)

    Dim lngItem As Long
    
    For lngItem = 1 To ApplyTo.Points.Count
        ApplyTo.Points(lngItem).MarkerBackgroundColor = _
                                                RGB(RColor.Cells(lngItem), _
                                                    GColor.Cells(lngItem), _
                                                    BColor.Cells(lngItem))
    Next
End Sub

Originally Posted by Andy Pope

The 2nd set where you make use of the same single function.

Thank you again for your help.