• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 8034
  • Last Modified:

VBA Creating Pie Chart

Need a little assistance. Creating a pie chart and I have the following code

Sub CreatePie()

Charts.Add
ActiveChart.ChartType = xlPie
ActiveChart.SetSourceData Source:=Sheets("RCSupport").Range("F1:H28"), PlotBy:= _
        xlColumns
    
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Scorecard (2)"
    ActiveChart.ChartTitle.Text = "Schedule Delay Averages # of Days/Store"
    ActiveChart.ShowAllFieldButtons = False
    ActiveChart.Legend.Delete
    ActiveChart.ApplyDataLabels xlDataLabelsShowValue, xlDataLabelsPercent
    ActiveChart.SeriesCollection(1).HasLeaderLines = False

End Sub

Open in new window


I can't figure out how to get the category name, value, and percent to all show on the pie chart and how to place the chart in a specific location would like it to be from a13:l42
0
jmac001
Asked:
jmac001
  • 5
  • 2
2 Solutions
 
andrew_manCommented:
Please attach your file here with additional ws for your wanted chart;

Thanks!
0
 
Rgonzo1971Commented:
Hi,

pls try

Sub CreatePie()

Charts.Add
ActiveChart.ChartType = xlPie
ActiveChart.SetSourceData Source:=Sheets("RCSupport").Range("F1:H28"), PlotBy:= _
        xlColumns
    
Set mychart = ActiveChart.Location(Where:=xlLocationAsObject, Name:="Scorecard (2)")
    mychart.ChartArea.Top = Range("A13").Top
    mychart.ChartArea.Left = Range("A13").Left
    mychart.ChartArea.Width = Range("A13:L42").Width
    mychart.ChartArea.Height = Range("A13:L42").Height

    mychart.ChartTitle.Text = "Schedule Delay Averages # of Days/Store"
    mychart.ShowAllFieldButtons = False
    mychart.Legend.Delete
    mychart.ApplyDataLabels xlDataLabelsShowValue, xlDataLabelsPercent
    mychart.SeriesCollection(1).HasLeaderLines = False
    With mychart.SeriesCollection(1).DataLabels
        .ShowCategoryName = True
        .ShowPercentage = True
        .Position = xlLabelPositionBestFit
        .Separator = ", "
    End With

End Sub

Open in new window

Regards
0
 
andrew_manCommented:
This is my code:-

Sub CreatePie()

With Sheets("Scorecard (2)")
NumCharts = .ChartObjects.Count
If NumCharts > 0 Then
For I = NumCharts To 1 Step -1
.ChartObjects(I).Delete
Next I
End If
End With

Charts.Add
With ActiveChart
    .ChartType = xlPie
    .SetSourceData Source:=Sheets("RCSupport").Range("F1:H28"), PlotBy:=xlColumns
    .ChartTitle.Text = "Schedule Delay Averages # of Days/Store"
    .ShowAllFieldButtons = False
    .Legend.Delete
    .ApplyDataLabels xlDataLabelsShowValue, xlDataLabelsPercent
         With .SeriesCollection(1)
         .HasLeaderLines = False
         With .DataLabels
         .ShowCategoryName = True
         .ShowValue = True
         .ShowPercentage = True
         .Position = xlLabelPositionOutsideEnd
         End With
         End With
    .Location Where:=xlLocationAsObject, Name:="Scorecard (2)"
End With

With ActiveChart.Parent
         .Top = Range("A13").Top
         .Left = Range("A13").Left
         .Height = Range("13:42").Height
         .Width = Range("A:L").Width
End With

End Sub

Open in new window

0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

 
jmac001Author Commented:
Andrew_man and Rgonzo1971 both codes work but quick question is it possible to delete any of the data labels where the percent is 0?



Rgonzo1971 I  like the code because it would act as a refresh, you included:
 
.Position = xlLabelPositionOutsideEnd

Open in new window


How would I change this to have the data label appear on the the slice, I will be adding code to change the font to white?
0
 
andrew_manCommented:
Okay, wait a minutes.
0
 
andrew_manCommented:
Sub CreatePie()

With Sheets("Scorecard (2)")
NumCharts = .ChartObjects.Count
If NumCharts > 0 Then
For I = NumCharts To 1 Step -1
.ChartObjects(I).Delete
Next I
End If
End With

Charts.Add
With ActiveChart
    .ChartType = xlPie
    .SetSourceData Source:=Sheets("RCSupport").Range("F1:H28"), PlotBy:=xlColumns
    .ChartTitle.Text = "Schedule Delay Averages # of Days/Store"
    .ShowAllFieldButtons = False
    .Legend.Delete
    .ApplyDataLabels xlDataLabelsShowValue, xlDataLabelsPercent
         With .SeriesCollection(1)
         .HasLeaderLines = False
         With .DataLabels
         .ShowCategoryName = True
         .ShowValue = True
         .ShowPercentage = True
         .Position = xlLabelPositionOutsideEnd
         End With
         End With
    .Location Where:=xlLocationAsObject, Name:="Scorecard (2)"
End With
           
    For Each srs In ActiveChart.SeriesCollection
        With srs
               
            If .HasDataLabels Then
                
                nPts = .Points.Count
                avals = .Values
                For ipts = 1 To nPts
                     MsgBox avals(ipts)
                     
                    If avals(ipts) = 0 Then
                        .Points(ipts).HasDataLabel = False
                    End If
                Next
            End If
        End With
    Next
           
           
With ActiveChart.Parent
         .Top = Range("A13").Top
         .Left = Range("A13").Left
         .Height = Range("13:42").Height
         .Width = Range("A:L").Width
End With

End Sub

Open in new window

0
 
andrew_manCommented:
By the way, we should delete the old chart
0
 
jmac001Author Commented:
Thank you both tweaked my code based on both of the codes provided and it is working as expected.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

  • 5
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now