Plotting XY Scatter via VBA working in Excel2010, not Excel2013

[raulsanchez]

Hi everybody,

I have a quadrant graph that contains 7 series, and I have been plotting XY Scatter points (starting at series 8 and increasing until the last of the data set is plotted) in the graph using VBA in Excel 2010. I now have one machine running on Excel2013, and the code that has run flawlessly on Excel2010 is generating plotting errors when used with Excel2013.

When the subroutine is assigning XValues and Values, the data points are not being assigned to the series. In the formula bar, each series is showing it's name and series number, but no X or Y coordinates.

I am curious if anybody else has stumbled upon this situation. Below is my code for the plotting.

Sub Plot_Chart()
    Dim wsData As Worksheet
    Dim wsChart As Worksheet
    Dim wsControl As Worksheet
    Dim lngStartRow As Long
    Dim lngLastRow As Long
    Dim lngCounter As Long
    Dim strLabelRevenue As String
    Dim n As Long

    Set wsData = Sheet9
    Set wsChart = Sheet3
    Set wsControl = Sheet4

    lngStartRow = 11
    lngLastRow = wsData.Cells(Rows.Count, 2).End(xlUp).Row
    lngCounter = 8

    wsChart.Activate
    ActiveSheet.ChartObjects(1).Activate

    'remove previous series
    For n = ActiveChart.SeriesCollection.Count To lngCounter Step -1
        ActiveChart.SeriesCollection(n).Delete
    Next n

    With ActiveChart.Axes(xlCategory, xlPrimary)
        .MaximumScale = 1
        .MinimumScale = 0
        .MajorUnit = 0.5
    End With

    'reload chart with new series
    For n = lngStartRow To lngLastRow

        strLabelRevenue = Format(wsData.Cells(n, 3), "$0,000")

        With ActiveChart
            With .SeriesCollection.NewSeries
                .ChartType = xlXYScatter
                .XValues = wsData.Cells(n, 5)
                .Values = wsData.Cells(n, 15)
                .Name = wsData.Cells(n, 2)
                .AxisGroup = 1
                .ApplyDataLabels Type:=xlDataLabelsShowLabel, _
                                 AutoText:=True, LegendKey:=False
                With .Points(1)
                    .DataLabel.Text = wsData.Cells(n, 2) & " - " & strLabelRevenue
                    .Interior.Color = vbRed
                    .MarkerStyle = xlMarkerStyleCircle
                    .MarkerSize = 13
                End With
            End With

            With .SeriesCollection(lngCounter).DataLabels
                .VerticalAlignment = xlCenter
                .Position = xlLabelPositionAbove
                .Orientation = xlHorizontal
                .AutoScaleFont = False
                .Font.Size = 10
                .Font.Bold = False
                .Font.ColorIndex = 0
            End With
            
        End With
        
        lngCounter = lngCounter + 1
        
    Next n

End Sub

Specifically, the following lines seem to be recognizing what the data points are, but they are not getting passed to the series formula.

   .XValues = wsData.Cells(n, 5)
   .Values = wsData.Cells(n, 15)

Any insight that could be shared is greatly appreciated. Thank you!!

 

[raulsanchez]

I have experimented with this problem, and have found if I cut and then paste the chart after the macro runs, the data series populate and appear. This appears to be the chart refreshing. However, if I copy and paste, or force other methods of chart recalculation using VBA, the error persists and the series remain empty.

 

[Jon Peltier]

I would insert the one-liner

DoEvents

after each End With statement.

 

[raulsanchez]

Hi Jon,

Thank you for the reply.

I have inserted DoEvents after each End With, and the result is unchanged.

Randomly, every X times running the code, it seems to trip up on

[COLOR=#333333].AxisGroup = 1[/COLOR]

as well, but forcing it to ignore that error makes it plot ok anyways. I thought perhaps the code was running too fast and not letting the series be plotted, so I inserted pauses between 1ms and 25ms with no results.

Regardless, still ending up with empty series until a Cut/Paste of the chart is done directly in the user interface. (Closing and reopening the file also forces the series to populate.)

Is it possible this is a bug in Excel2013?

 

[raulsanchez]

I have put together a sample workbook in case anybody wants to see if this error occurs on their system. If you would like to receive a copy of this file, please let me know and I can email it to you.

As it turns out, the foundation of this chart comes from Jon's website posting last year:
Shaded Quadrant Background for Excel XY Scatter Chart - Peltier Tech Blog

 

[Jon Peltier]

Pauses don't work, they just make everything stop.

DoEvents tells VBA to wait for things to get caught up. Sometime I insert DoEvents several places. Before any command that sometimes gets hung up.

I don't know if it will help, but sometimes changing the order of commands helps. For example, I usually set the .Values before the .XValues. Set each one then insert DoEvents after it.

Unfortunately there is nothing that can be blamed a priori for this problem.

 

[raulsanchez]

Thanks for the additional input Jon. I have managed to get something to work.

I tried inserting numerous instances of DoEvents. This itself did not help.

Then I tried removing the actions regarding axes and data labels to separate loops. This itself did not help.

Then I tried both separate loops for various actions combined with multiple instances of DoEvents. This helped!! But, didn't solve the problem entirely. I was able to initially plot the chart successfully once, then replot only once or twice more before the same problem appeared again. Cutting and pasting the chart in place or closing/reopening the file is the only way I can get the chart to come alive again.

However, now with the separate loops and the DoEvents in the routine I can cut and paste the chart in place using VBA and the chart refreshes the data series. Previously cutting and pasting using VBA was causing Excel to crash. It isn't elegant, but it is working.

Here is the updated code for anybody else struggling with this same issue:

Option Explicit


Public Declare Function GetTickCount Lib "kernel32" () As Long
Private lngStart As Long


    Private Sub TimerStart()
         lngStart = GetTickCount()
     End Sub


     Private Sub TimerEnd()
         MsgBox GetTickCount() - lngStart & " ms"
     End Sub


Sub Plot_Chart()


    Dim wsData As Worksheet
    Dim wsChart As Worksheet
    Dim wsControl As Worksheet
    Dim objChart As ChartObject
    Dim lngStartRow As Long
    Dim lngLastRow As Long
    Dim lngCounter As Long
    Dim strLabelRev As String
    Dim n As Long


    Set wsData = Sheet9
    Set wsChart = Sheet3
    Set wsControl = Sheet4
    wsChart.Activate
    Set objChart = Sheet3.ChartObjects(1)


    lngStartRow = 11
    lngLastRow = wsData.Cells(Rows.Count, 2).End(xlUp).Row
    lngCounter = 8


    Application.StatusBar = "Plotting chart, please wait."


    Application.ScreenUpdating = False


    Call TimerStart


    'remove previous series
    For n = objChart.Chart.SeriesCollection.Count To lngCounter Step -1
        objChart.Chart.SeriesCollection(n).Delete
    Next n




    Application.ScreenUpdating = True
    DoEvents    'let OS catch up to code
    Application.ScreenUpdating = False




    'set primary axis
    With objChart.Chart.Axes(xlCategory, xlPrimary)
        .MaximumScale = 1
        .MinimumScale = 0
        .MajorUnit = 0.5
    End With




    'reload chart with new series
    For n = lngStartRow To lngLastRow
        With objChart.Chart
            With .SeriesCollection.NewSeries
                .ChartType = xlXYScatter
                .Values = wsData.Range("O" & n)
                .XValues = wsData.Range("E" & n)
            End With
            DoEvents    'let OS catch up to code
        End With
        lngCounter = lngCounter + 1
        Application.StatusBar = "Plotting series: " & (GetTickCount() - lngStart) / 50
    Next n
    DoEvents    'let OS catch up to code




    'set axis and activate data labels
    lngCounter = 8
    For n = lngStartRow To lngLastRow
        With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(lngCounter)
            .AxisGroup = 1
            .Name = wsData.Range("B" & n)
            .ApplyDataLabels Type:=xlDataLabelsShowLabel, _
                             AutoText:=True, LegendKey:=False
        End With
        DoEvents   'let OS catch up to code
        lngCounter = lngCounter + 1
        Application.StatusBar = "Plotting series: " & (GetTickCount() - lngStart) / 50
    Next n
    DoEvents    'let OS catch up to code




    'create data labels
    lngCounter = 8
    For n = lngStartRow To lngLastRow
        strLabelRev = Format(wsData.Cells(n, 3), "$0,000")
        With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(lngCounter).Points(1)
            .DataLabel.Text = wsData.Cells(n, 2) & " - " & strLabelRev
            .MarkerStyle = xlMarkerStyleCircle
            .MarkerSize = 10
        End With
        DoEvents
        lngCounter = lngCounter + 1
        Application.StatusBar = "Plotting series: " & (GetTickCount() - lngStart) / 50
    Next n




    'position data labels
    lngCounter = 8
    For n = lngStartRow To lngLastRow
        With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(lngCounter).DataLabels
            .VerticalAlignment = xlCenter
            .Position = xlLabelPositionAbove
            .Orientation = xlHorizontal
            .AutoScaleFont = False
            .Font.Size = 10
            .Font.Bold = False
            .Font.ColorIndex = 0
        End With
        DoEvents
        lngCounter = lngCounter + 1
        Application.StatusBar = "Plotting series: " & (GetTickCount() - lngStart) / 50
    Next n


    DoEvents  'let OS catch up to code


    Application.StatusBar = "Plotting completed in " & (GetTickCount() - lngStart) / 1000 & " seconds"
    
    'cut and paste in place to prevent chart engine errors upon replotting
    wsChart.ChartObjects(1).Activate
    ActiveChart.Parent.Cut
    wsChart.Range("B4").Select
    wsChart.Paste


    Application.ScreenUpdating = True


    'clean up
    Set objChart = Nothing
    Set wsData = Nothing
    Set wsChart = Nothing
    Set wsControl = Nothing


End Sub