Formatting value and percentage in stacked chart with VBA

[iceblocks]

Hi all,

As Excel does not provide percentage as a data label for stacked column/bar chart, I have found this code which works really well as it insert the percentages as text. However, the problem is that I need data label in the form of both value and percentage. And because the macro is to enter the data label as text to cater for the percentage, it does not let me change the numbering format when showing values. As I am working with values that are in the millions, I need to change the number formatting to include 'M'. Also at the moment, the data label is in the form of value and percentage with no space in between (e.g. 1200000010%), which ideally would like to be 12M,10%. Any suggestions would be most appreciated.

Sub set_data_labels_to_bar_chart1()

  With ActiveChart
  For i = 1 To .SeriesCollection.Count
  .SeriesCollection(i).HasDataLabels = True
  Next i
  For i = 1 To .SeriesCollection(1).Points.Count
  s = 0
  For j = 1 To .SeriesCollection.Count
  v = .SeriesCollection(j).Values
  s = s + v(i)
  Next j
  For j = 1 To .SeriesCollection.Count
  v = .SeriesCollection(j).Values
  .SeriesCollection(j).Points(i).DataLabel.Text = Format(v(i) & v(i) / s, "0%")
  
  
  'this delete value if less or equal to 0
  If v(i) <= 0 Then .SeriesCollection(j).Points(i).DataLabel.Delete
  Next j
  Next i
  
  End With
  
End Sub

Thanking you in advance.

 

[Hui]

I would use the following

Sub set_data_labels_to_bar_chart1()

Dim i As Integer
Dim j As Integer
Dim s As Double
Dim v As Variant

Dim NoDigits As Integer
Dim PercentFormat As String
Dim myTxt As String

NoDigits = 1 'How many digits to round Millions to
PercentFormat = "0.0%" 'Format string for the Percentages

With ActiveChart
  For i = 1 To .SeriesCollection.Count
  .SeriesCollection(i).HasDataLabels = True
  Next i
 
  For i = 1 To .SeriesCollection(1).Points.Count
  s = 0
   
  For j = 1 To .SeriesCollection.Count
  v = .SeriesCollection(j).Values
  s = s + v(i)
  Next j
   
  For j = 1 To .SeriesCollection.Count
  v = .SeriesCollection(j).Values
  myTxt = Round(v(i) / 1000000#, NoDigits) & "M, " & Format(v(i) / s, PercentFormat)
  .SeriesCollection(j).Points(i).DataLabel.Text = myTxt
   
  If v(i) <= 0 Then .SeriesCollection(j).Points(i).DataLabel.Delete
  Next j
  Next i
End With
End Sub

 

[iceblocks]

Thank you so much Hui. It worked perfectly!