Add percentage values to pie chart with vba

[roninn75]

hi

i have a map with clickable shapes. when i click on a shape a pie chart is created from data i pull from a seperate sheet call "Data". i want to add the percentage values to the chart but it kicks out an error 91 highlighting this line of code:

Code: Select all

ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent

.

any assistance would be helpful

Code: Select all

Sub SLR()
Charts.Add
ActiveChart.ChartType = xlPie
ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H5")
ActiveChart.Location Where:=xlLocationAsObject, Name:="CoCT Map"
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent
'ActiveChart.SeriesCollection(1).DataLabels.NumberFormat = "0.0%"
Add_Chart
ActiveSheet.Shapes.Range(Array("TextBox 39")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "SLR test"
   
Range("C3").Select
End Sub

Add_Chart is a function to size and position the chart. If I indent the line producing the error the chart is generated but no percentage values inside...

[HansV]

The line runs without error when I try it. Could you post a stripped-down copy of the workbook?

[roninn75]

Here goes... thank you

[HansV]

Ah - I see. Moving the chart to the Map sheet invokes that sheet's Sheet_Activate event procedure. This procedure deselects the chart, so when it has run, ActiveChart is no longer valid. To avoid this, you can temporarily disable events:

Code: Select all

Sub RDS()
    Application.EnableEvents = False
    Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H5")
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Map"
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent
    ActiveChart.SeriesCollection(1).DataLabels.NumberFormat = "0.0%"
    Add_Chart
    ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "RDS Test"
    Application.EnableEvents = True
End Sub

[roninn75]

thank you :)

[roninn75]

how can i delete the chart before each new chart is created? I see i have a build up of charts with each selection i make...

[HansV]

You can add a few lines of code:

Code: Select all

Sub RDS()
    Application.EnableEvents = False
    ' Delete chart if it already exists
    On Error Resume Next
    Worksheets("Map").ChartObjects(1).Delete
    On Error GoTo 0
    Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H5")
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Map"
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent
    ActiveChart.SeriesCollection(1).DataLabels.NumberFormat = "0.0%"
    Add_Chart
    ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "RDS Test"
    Application.EnableEvents = True
End Sub

To delete all charts in one go:

Code: Select all

Sub DeleteAllCharts()
    Dim i As Long
    With Worksheets("Map")
        For i = .ChartObjects.Count To 1 Step -1
            .ChartObjects(i).Delete
        Next i
    End With
End Sub

[roninn75]

thank you

[roninn75]

i realise it would be inefficient of me to copy the same code with just the referencing to the source data thats changing. using a select case would make for much easier reading of the code. so with that in mind,

Code: Select all

Sub S_Chart()
    Application.EnableEvents = False
    ' Delete chart if it already exists
    On Error Resume Next
    Worksheets("Map").ChartObjects(1).Delete
    On Error GoTo 0
    Charts.Add
    ActiveChart.ChartType = xlPie
    Select Case myChart
     Case is = RDS
         ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H5")
         ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "RDS Test"
    Case is = SLR
        ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H4, E6:H6")
         ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "SLR Test"
    End Select

    ActiveChart.Location Where:=xlLocationAsObject, Name:="Map"
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent
    ActiveChart.SeriesCollection(1).DataLabels.NumberFormat = "0.0%"
    Add_Chart
        Application.EnableEvents = True
End Sub

the above code kicks out errors. Where am I going wrong?

[HansV]

myChart isn't defined. How would you like to determine which chart you want?

[roninn75]

only one chart gets added, therefor the select case should refer to the shape and not the chart, am i right?

[HansV]

You can use Application.Caller for that purpose:

Code: Select all

Sub S_Chart()
    Application.EnableEvents = False
    ' Delete chart if it already exists
    On Error Resume Next
    Worksheets("Map").ChartObjects(1).Delete
    On Error GoTo 0
    Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Map"
    Select Case Application.Caller
        Case "S_RDS"
            ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H5")
            ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "RDS Test"
        Case "S_SPT"
            ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H4, E6:H6")
            ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "SPT Test"
        Case "S_SLR"
            ActiveChart.SetSourceData Source:=Sheets("Data").Range("E4:H4, E7:H7")
            ActiveSheet.Shapes("TextBox 39").TextFrame2.TextRange.Characters.Text = "SLR Test"
        End Select
    ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent
    ActiveChart.SeriesCollection(1).DataLabels.NumberFormat = "0.0%"
    Add_Chart
    Application.EnableEvents = True
End Sub

See the attached workbook.

Mapping_Template_Sample.xlsm