Color chart series based on color pattern in a range

Vishesh's picture
Download the attached utility to color the chart series/categories according to the specified color code. Comments have been added the the code.

Color Chart Series

Sub ColorChartSeries(rngColorPattern As Range, Optional cht As Chart, Optional blnListColorCodeError As Boolean = True)
'Three ways to call this method
    '1. Pass only the Color pattern range - this will color all charts in activesheet
    'and also show the series/category name if a color code is not found for the same
    '2. Pass the specific chart to color
    '3. the last argument is optional and True by default
    Dim blnChartTypePie     As Boolean
    Dim vCategories         As Variant
    Dim intSeries           As Integer
    Dim intCategory         As Integer
    Dim strSrsNotFound      As String
    Dim strTest             As String
    Dim rngSeries           As Range
    Dim rngCategory         As Range
    Dim chtActSht           As ChartObject
 
    If cht Is Nothing Then
        For Each chtActSht In ActiveSheet.ChartObjects
            Call ColorChartSeries(rngColorPattern, chtActSht.Chart, blnListColorCodeError)
            Set cht = chtActSht.Chart
        Next chtActSht
    End If
 
    If cht Is Nothing Then Exit Sub
 
    'Check if a chart is pie or not
    On Error Resume Next
    strTest = cht.Axes(xlValue, xlPrimary).MaximumScale
    If Err.Number = 0 Then
        blnChartTypePie = False
    Else
        blnChartTypePie = True
    End If
    On Error GoTo 0: Err.Clear: On Error GoTo -1
 
    With cht
        If blnChartTypePie = False Then
            'if chart is not a pie
            For intSeries = 1 To .SeriesCollection.Count
                Set rngSeries = rngColorPattern.Find(What:=.SeriesCollection(intSeries).Name, lookat:=xlWhole)
                If Not rngSeries Is Nothing Then
                    With .SeriesCollection(intSeries)
                        .Interior.Color = rngSeries.Interior.Color
                        .Interior.Pattern = xlSolid
                        .Border.Color = rngSeries.Interior.Color
 
                        On Error Resume Next
                        .MarkerForegroundColor = rngSeries.Interior.Color
                        .MarkerBackgroundColor = rngSeries.Interior.Color
                        On Error GoTo 0
 
                        'Bubble chart
                        '.Border.Weight = xlThin
                        '.Border.LineStyle = 1
                        .Shadow = False
                        '.InvertIfNegative = True
                        .Has3DEffect = True
                    End With
                Else
                    If Len(Trim(.SeriesCollection(intSeries).Name)) <> 0 Then
                        strSrsNotFound = strSrsNotFound & vbLf & .SeriesCollection(intSeries).Name
                    End If
                End If
            Next intSeries
        Else
            'Pie chart
            With .SeriesCollection(1)
                vCategories = .XValues
                For intCategory = 1 To UBound(vCategories)
                    Set rngCategory = rngColorPattern.Find(What:=vCategories(intCategory), lookat:=xlWhole)
                    If Not rngCategory Is Nothing Then
                        .Points(intCategory).Interior.Color = rngCategory.Interior.Color
                    Else
                        strSrsNotFound = strSrsNotFound & vbLf & vCategories(intCategory)
                    End If
                Next intCategory
            End With
        End If
    End With
 
    If strSrsNotFound <> "" And blnListColorCodeError = True Then
        MsgBox "Color code not found for..." & vbLf & strSrsNotFound, vbInformation, "Chart: " & cht.Name
    End If
 
    Set rngSeries = Nothing
    Set chtActSht = Nothing
    Set rngCategory = Nothing
End Sub
AttachmentSize
ColorChartSeries.xlsm29.92 KB
Vishesh's picture

Slight change in the

Slight change in the code...

If cht Is Nothing Then
For Each chtActSht In ActiveSheet.ChartObjects
Call ColorChartSeries(rngColorPattern, chtActSht.Chart, blnListColorCodeError)
'Set cht = chtActSht.Chart 'commented
Next chtActSht
Exit Sub 'New line added
End If