Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA looping through all series within all charts

Tags:

excel

vba

charts

I'm having an issue with the looping through of several charts in my VBA code. I'm 99.7% sure that this is a really easy and quick fix but my brain isn't working today.

I want the code to loop through every chart on the ActiveSheet, and for every data series that the chart contains I want it to add the last value of the series. In my example I have 9 charts, each with 3 series in them (bound to change, some have 2 but I digress).

I have the following code

Sub AddLastValue()
Dim myChartObject As ChartObject
Dim myChart As Chart
Dim mySrs As Series
Dim myPts As Points

With ActiveSheet
For Each myChartObject In .ChartObjects
    For Each myChart In .Chart
        For Each mySrs In .SeriesCollection
            Set myPts = .Points
            myPts(myPts.Count).ApplyDataLabels Type:=xlShowValue
        Next
    Next
Next
End With

End Sub

If I remove the looping code and just do a

Set myPts = ActiveSheet.ChartObjects(1).Chart. _
    SeriesCollection(1).Points
myPts(myPts.Count).ApplyDataLabels type:=xlShowValue

Then it works for that specific chart and series, so I'm positive it is the looping that I'm messing up.

Could someone tell me where I mess up the looping code?

like image 449
Tanaka Saito Avatar asked Jan 16 '14 15:01

Tanaka Saito


2 Answers

Try following code:

Sub AddLastValue()
    Dim myChartObject As ChartObject
    Dim mySrs As Series
    Dim myPts As Points

    With ActiveSheet
        For Each myChartObject In .ChartObjects
            For Each mySrs In myChartObject.Chart.SeriesCollection
                Set myPts = mySrs.Points
                myPts(myPts.Count).ApplyDataLabels Type:=xlShowValue
            Next
        Next
    End With

End Sub
like image 128
Dmitry Pavliv Avatar answered Sep 28 '22 20:09

Dmitry Pavliv


Not work for empty values.

This code find last not empty value and then adds label.

For Each mySrs In myChartObject.Chart.SeriesCollection
      Set myPts = mySrs.Points
      Dim i As Integer
      i = myPts.Count
      Do Until i < 2 Or mySrs.Values(i) <> ""
        i = i - 1
      Loop
      myPts(i).ApplyDataLabels Type:=xlShowValue
Next
like image 27
Andrzej Jackiewicz Avatar answered Sep 28 '22 20:09

Andrzej Jackiewicz