How determine the color of Excel chart series

[BlackieHamel]

I have some Column charts in different places, and I want to assign the same color to each member of the series each time. When I select a series, I see how to change its color, but I want to know WHAT THAT COLOR IS so I can remember to use it again in the next chart. Is there an easy way to do this?
Blackie

 

[GWteB]

Instead of actually changing the color you could write its number down but it looks like you mean something else
See if this suits your needs. This code shows the series's colors on a newly added worksheet. Note the use of a separate getRGB function.

Sub BlackieHamel()

    Dim oWs     As Worksheet
    Dim oShp    As Shape
    Dim oSrs    As Series
    Dim clr     As Long
    Dim n       As Long

    Set oWs = ActiveSheet           ' << change to suit
    With oWs.Parent.Worksheets.Add
        n = n + 1
        .Cells(n, 1) = "Sheet"
        .Cells(n, 2) = "Shape"
        .Cells(n, 3) = "Series"
        .Cells(n, 4) = "ForeColor Fill"
        .Cells(n, 7) = "ForeColor Line"
        Range(.Cells(n, 4), .Cells(n, 5)).HorizontalAlignment = xlCenterAcrossSelection
        Range(.Cells(n, 7), .Cells(n, 8)).HorizontalAlignment = xlCenterAcrossSelection
        Range(.Cells(n, 1), .Cells(n, 9)).Font.Bold = True
        
        For Each oShp In oWs.Shapes
            If oShp.Type = msoChart Then
                For Each oSrs In oShp.Chart.FullSeriesCollection
                    n = n + 1
                    .Cells(n, 1) = oShp.Parent.Name
                    .Cells(n, 2) = oShp.Name
                    .Cells(n, 3) = oSrs.Name

                    clr = oSrs.Format.Fill.ForeColor
                    .Cells(n, 4) = clr
                    .Cells(n, 5) = getRGB(clr)
                    If Not clr = &HFFFFFF Then
                        .Cells(n, 6).Interior.Color = clr
                    Else
                        .Cells(n, 6).Interior.Pattern = xlNone
                    End If

                    clr = oSrs.Format.Line.ForeColor
                    .Cells(n, 7) = clr
                    .Cells(n, 8) = getRGB(clr)
                    If Not clr = &HFFFFFF Then
                        .Cells(n, 9).Interior.Color = clr
                    Else
                        .Cells(n, 9).Interior.Pattern = xlNone
                    End If
                Next
            End If
        Next oShp
        .Range("A1", .Columns(9)).Columns.AutoFit
    End With
End Sub

Function getRGB(ByVal argColor As Long) As String
    Dim r As Integer, g As Integer, b As Integer
    r = (argColor And &HFF)
    g = (argColor And &HFF00&) / &H100
    b = (argColor And &HFF0000) / &H10000
    getRGB = "RGB(" & r & ", " & g & ", " & b & ")"
End Function

 

[BlackieHamel]

Thanks, GWteB, for doing all that -- I think it's more than I asked for! But I'd like to play with this.

I'm not sure of the syntax for the line you marked "<< change to suit". I presume I put the filename in there, but what follows "Set oWs = ActiveSheet"? I tried a filename in "quotation marks" a filename preceded by "=", by ".", by leaving it blank -- but everything generates an error.

Blackie

 

[GWteB]

I see ... paste my code in a standard module within a workbook in which your charts are. Select a worksheet with one ore more charts on it. In terms of VBA that's now the ActiveSheet.
Click on Ribbon > Developer tab > Macros > select BlackieHamel and press Run.

 

[BlackieHamel]

I had done all that, but it looked like you were telling me to finish the argument with something after "Set oWs = ActiveSheet". If I try to run the macro as sent, it generates an error: Run-time error: '13': Type mismatch

When I press Debug, it takes me to the highlighted line

Set oWs = ActiveSheet ' << change to suit

 

[GWteB]

That's odd. I copied my code with the Copy to Clipboard button, pasted it in a new workbook with one empty sheet. Even then the code did not error.
I suggest you do the same. Use the copy button on the top right hand of the code pane (see image) and paste the code (without making any changes!) in a standard module in your workbook.

 

[BlackieHamel]

Thanks. I didn't know about that Copy to Clipboard button.

But it still didn't work. See attached

 

[BlackieHamel]

I meant to attach this image, too.

 

[GWteB]

I know why this is happening, I am rebuilding the code ....

 

[GWteB]

Forget about my post #2 code, the below code is likely to run without hesitation. It now takes all sheets (worksheets and charts) into account.

Sub BlackieHamel_r2()

    Dim oWs     As Worksheet
    Dim oWsPlot As Worksheet
    Dim oShp    As Shape
    Dim oChart  As Chart
    Dim oSrs    As Series
    Dim clr     As Long
    Dim n       As Long

    Set oWsPlot = ThisWorkbook.Worksheets.Add
    Call PlotInfo(oWsPlot, oChart, True)

    For Each oChart In ThisWorkbook.Charts
        Call PlotInfo(oWsPlot, oChart)
    Next oChart

    For Each oWs In ThisWorkbook.Worksheets
        For Each oShp In oWs.Shapes
            If oShp.Type = msoChart Then
                Call PlotInfo(oWsPlot, oShp.Chart)
            End If
        Next oShp
    Next oWs
    oWsPlot.Range("A1", oWsPlot.Columns(9)).Columns.AutoFit
End Sub

Sub PlotInfo(ByVal argWs As Worksheet, ByVal argChart As Chart, Optional ByVal argHeader As Boolean = False)

    Static n    As Long
    Dim oSrs    As Series
    Dim clr     As Long

    With argWs
        If argHeader Then
            n = 1
            .Cells(n, 1) = "Chart"
            .Cells(n, 2) = "Series"
            .Cells(n, 3) = "ForeColor Fill"
            .Cells(n, 6) = "ForeColor Line"
            Range(.Cells(n, 3), .Cells(n, 4)).HorizontalAlignment = xlCenterAcrossSelection
            Range(.Cells(n, 6), .Cells(n, 7)).HorizontalAlignment = xlCenterAcrossSelection
            Range(.Cells(n, 1), .Cells(n, 8)).Font.Bold = True
        Else
            For Each oSrs In argChart.FullSeriesCollection
                n = n + 1
                .Cells(n, 1) = oSrs.Parent.Parent.Name
                .Cells(n, 2) = oSrs.Name

                clr = oSrs.Format.Fill.ForeColor
                .Cells(n, 3) = clr
                .Cells(n, 4) = getRGB(clr)
                If Not clr = &HFFFFFF Then
                    .Cells(n, 5).Interior.Color = clr
                Else
                    .Cells(n, 5).Interior.Pattern = xlNone
                End If

                clr = oSrs.Format.Line.ForeColor
                .Cells(n, 6) = clr
                .Cells(n, 7) = getRGB(clr)
                If Not clr = &HFFFFFF Then
                    .Cells(n, 8).Interior.Color = clr
                Else
                    .Cells(n, 8).Interior.Pattern = xlNone
                End If
            Next
        End If
    End With
End Sub

Function getRGB(ByVal argColor As Long) As String
    Dim r As Integer, g As Integer, b As Integer
    r = (argColor And &HFF)
    g = (argColor And &HFF00&) / &H100
    b = (argColor And &HFF0000) / &H10000
    getRGB = "RGB(" & r & ", " & g & ", " & b & ")"
End Function