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?

 

[Jon Peltier]

What ranges contain the categories? Are they the ranges you expect?

Variant/Empty for the two categories in the pie chart indicates that the X values are undefined, that is, are not linked to a worksheet range.

I can't imagine why the X Values of the column chart would have an extra category the first time you run the code, and not the second.

 

[weezy]

I should clarify I am creating fifteen charts of various types and have this code running as part of the creation procedure for each column and pie chart. The data is on a different worksheet to the colour ranges (which are named ranges).

If I run (F5) the procedure to change existing charts, it does work but want to run the formatting as I'm creating the charts as I pass in the Chart Title, worksheet on which to find the data table, colour range and various other options my generic create chart procedures.

 

[Jon Peltier]

I guess it would help if you showed more of the relevant code.

 

[weezy]

Jon, I was posting my clarification at the same time you were responding. I am creating the chart first so I know its picking up the correct range for the xValues to do that. The format range is a named range which doesn't appear to be an issue because it's the vCategories that are not being picked up correctly.

The xValues of the column chart doesn't have an extra category, it has the wrong value in the first category. It replaces the '1' with the correct text when I loop it through again.

My pie chart create code is:

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
    
    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

    Dim rgPattern As Range
   
    Set rgPattern = Range(colourRange)

     ColourCode rgPattern, ch
    
End Sub

This is the code to do the formatting (when I had this in the above procedure it did the same thing - debug was OK, F5 wasn't):

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

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

    With ch.Chart.SeriesCollection(1)

        vCategories = .XValues

        For iCategory = 1 To UBound(vCategories)
            x = 0
retry:
            Set rCategory = rgPattern.Find(what:=vCategories(iCategory), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            If rCategory Is Nothing Then
                x = x + 1
                vCategories = .XValues
                If x < 2 Then
                    GoTo retry
                    Else
                    .Points(iCategory).Format.Fill.ForeColor.RGB = RGB(185, 205, 229)
                End If
                Else
         
            .Points(iCategory).Format.Fill.ForeColor.RGB = rCategory.Interior.Color
            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

Any assistance would be appreciated.

 

[Jon Peltier]

When code gives a funny result when running at full speed, but works fine when you F8 your way through it, there is often a timing problem. VBA might be slightly ahead of what Windows and Excel have assimiliated. You might be populating vCategories in VBA at the same time that Excel is assigning the range to the chart series, and VBA doesn't pick up all the right values. I seem to need this more and more often in later versions of Excel and Windows.

This kind of thing can be fixed by inserting the one-line command

DoEvents

right before the line of code where the error occurs. DoEvents tells VBA to wait a moment while the system updates everything. You don't need to insert DoEvents often. Sometimes once is enough if you put it in the right place.

 

[weezy]

I was hoping that moving the formatting code out to its sub would have helped with timing issues but it obviously didn't.

I have now tried DoEvents in various and multiple places throughout the code (including right before setting the vCategories) and it isn't making any difference I may have to bite the bullet and run through the pie chart formatting after all charts have been created.

 

[jsotola]

do you have your charts on more than one worksheet?

 

[weezy]

The charts are all on one worksheet.
The chart data ranges are spread over a couple of other worksheets.
The colour formatting ranges are on a separate worksheet.

 

[Jon Peltier]

1. When you set vCategories, you could insert a test of the values. For example, in the pie chart data,

x = 0
Do
    vCategories = .XValues
    If Len(vCategories(1) > 0 Then Exit Do
    x = x+1
    If x > 2 Then
        ' handle the error here
        Exit Do
    End If
Loop

or for the column chart:

x = 0
Do
    vCategories = .XValues
    If Not IsNumeric(vCategories(1)) Then Exit Do
    x = x+1
    If x > 2 Then
        ' handle the error here
        Exit Do
    End If
Loop

2. Alternatively, since you know the data range when you construct the chart, use it instead.

vCategories = DataRange.Columns(1) ' account for first row for labels if needed

Note that now vCategories is a 2-dimensional array.