Formatting charts by category label VBA not getting correct variant values

[weezy]

I'm using John Peltier's Formatting of charts by Category label code from VBA Conditional Formatting of Charts by Category Label - Peltier Tech Blog to format the colour of Column and Pie charts in Excel 2010.

 With ch.Chart.SeriesCollection(1)
        vCategories = .XValues
        For iCategory = 1 To UBound(vCategories)
            Set rCategory = rgPattern.Find(what:=vCategories(iCategory), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            .Points(iCategory).Format.Fill.ForeColor.RGB = rCategory.Interior.Color
        Next
        .Format.ThreeD.BevelTopType = msoBevelCircle
    End With

I can step through the code and it works fine for both types of charts but if I run (F5) it will error at

.Points(iCategory).Format.Fill.ForeColor.RGB = rCategory.Interior.Color

due to vCategories not having the correct value assigned.

For example, my Pie Charts which have two categories show the following in the Locals window:
vCategories
- vCategories(1) . . . . . . . . Empty . . . . . . . . Variant/Empty
- vCategories(2) . . . . . . . . Empty . . . . . . . . Variant/Empty

the column charts seem to put the value 1 in as the first entry, but are assigning properly for the rest:
vCategories
- vCategories(1) . . . . . . . . 1 . . . . . . . . . . .Variant/Double
- vCategories(2) . . . . . . . . "Mag" . . . . . . . . Variant/String
- vCategories(3) . . . . . . . . "Hem" . . . . . . . . Variant/String
- vCategories(4) . . . . . . . . "etc" . . . . . . . . . Variant/String

If I go up and step through the vCategories = .xValues line again, they will assign properly, so I have tried looping a couple of times and that works for the column charts but I only ever get one vCategory assigned for the Pie charts, and therefore only one coloured segment.

Has anyone else come across this problem or have any idea how I can get it to work properly first time every time?

 

[weezy]

Jon, Option 2 is the answer that I would never have thought of and the simplest solution, thank you so much.

My code is now working first time, every time:

Private Sub CreatePieChart(wsData As String, chartHeading As String, colourRange As String, blnLegend As Boolean)

    Dim dataRange As Range
    Dim ch As ChartObject
    Dim wsCharts As Worksheet
    Dim dataWS As Worksheet
    Dim rgPattern As Range
    
    Set rgPattern = Range(colourRange)
    Set wsCharts = Worksheets("Charts")
    Set dataWS = Worksheets(wsData)
    
    Set dataRange = GetChartDataRange(wsData, chartHeading)
    
    Set ch = wsCharts.ChartObjects.Add(Left:=cLeft + (((wsCharts.ChartObjects.Count + 1) - 1) Mod cCOLUMNS) * cWIDTH, width:=cWIDTH, _
                                        Top:=cTop + Int(((wsCharts.ChartObjects.Count + 1) - 1) / cCOLUMNS) * cHEIGHT, Height:=cHEIGHT)
    wsCharts.Activate
    With ch.Chart
        .ChartType = xlPie
        .HasLegend = blnLegend
        .SetSourceData Source:=dataRange
        .HasTitle = True
        .ChartTitle.Text = dataRange(1, 1).Offset(-1, 0).Text
        .SeriesCollection(1).ApplyDataLabels
        With ch.Chart.SeriesCollection(1).DataLabels
            .ShowCategoryName = True
            .ShowValue = False
            .ShowPercentage = True
            With .Format.TextFrame2.TextRange.Font
                .Bold = msoTrue
                .Fill.ForeColor.RGB = RGB(255, 255, 255)
            End With
            .Position = xlLabelPositionInsideEnd
        End With
    End With

    ColourCode rgPattern, ch, [B]dataRange[/B]
    
End Sub

simply by passing in the datarange that I already have available:

Private Sub ColourCode(rgPattern As Range, ch As ChartObject, dataRange As Range)

    Dim iCategory As Long
    Dim vCategories As Variant
    Dim rCategory As Range
    Dim x As Integer

    With ch.Chart.SeriesCollection(1)

        vCategories = [B]Range(dataRange(2, 1), dataRange(dataRange.Rows.Count, 1))[/B]

        For iCategory = 1 To UBound(vCategories)

            Set rCategory = rgPattern.Find(what:=vCategories(iCategory, 1), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            If rCategory Is Nothing Then
                .Points(iCategory).Format.Fill.ForeColor.RGB = RGB(185, 205, 229) 'colour code for all other business unit depts
            Else
                .Points(iCategory).Format.Fill.ForeColor.RGB = rCategory.Interior.Color 'colour code our depts
            End If
        Next
        
        .Format.ThreeD.BevelTopType = msoBevelCircle
        
        If UBound(vCategories) > 10 Then
            ch.Chart.Axes(xlCategory).TickLabels.Orientation = 45
            ch.Chart.ChartGroups(1).GapWidth = 20
          ElseIf UBound(vCategories) <= 5 Then
            ch.Chart.ChartGroups(1).GapWidth = 2
        End If
        
    End With
End Sub

 

[Jon Peltier]

Awesome!