# Excel donut chart with multiple levels

Excel Version
1. 2013
This article shows how to create a donut chart with multiple levels.
• Figure 1 shows how to arrange the source data in order to get the layers. If necessary, you can have two starting angles. To accomplish that, use a secondary axis. The chart below has one series on the primary axis and the other two on the secondary. It is a combination chart, and the hole size for the primary series is smaller.
• Figures 2 and 3 are extreme examples of this technique, the amphitheatre and the Nakshatra chart. Both use a source table with 11 columns and 276 rows.
• The code used to apply some formatting to the Nakshatra chart is also shown, as well as a link to the test workbook.
• One advantage of this method is that the charts are highly customizable via VBA.
nak_final.xlsm

VBA Code:
Sub Main()
Dim c As Chart, d As DataLabel, arr, i%, p As Point, pts As Points, cs As Worksheet, j%, a, s As Series
Set cs = Sheets("sheet2")
Set c = cs.ChartObjects("chart 4").Chart
arr = Sheets("sheet1").[c20:c31]
c.FullSeriesCollection(3).ApplyDataLabels
j = 0
For i = cs.Range("d1").End(xlDown).Row To cs.Range("d" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(3).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(3), 0
arr = Sheets("sheet1").[d20:d127]
j = 0
For i = cs.Range("g1").End(xlDown).Row To cs.Range("g" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(6).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(6), 0
c.FullSeriesCollection(8).ApplyDataLabels
arr = Sheets("sheet1").[g20:g46]
j = 0
For i = cs.Range("i1").End(xlDown).Row To cs.Range("i" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(8).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(8), 0
c.FullSeriesCollection(10).ApplyDataLabels
arr = Sheets("sheet1").[h20:h46]
j = 0
For i = cs.Range("k1").End(xlDown).Row To cs.Range("k" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(10).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(10), 0
a = Array(3, 6, 8, 10)
On Error Resume Next
For j = LBound(a) To UBound(a)
Set s = c.SeriesCollection(a(j))
For i = 1 To s.Points.Count
If s.Points(i).DataLabel.Text = "0" Then s.Points(i).DataLabel.Delete
Next
Next
End Sub

Public Sub DoCircAlign(oSeries As Series, radial As Boolean)
' by Krisztina Szabó
Dim oChart As Chart, oPoint As Point, ox As Double, oy As Double, value
Dim sum As Double, angleSoFar As Double, i As Long
Set oChart = oSeries.Parent.Parent 'Series < ChartGroup < Chart
ox = oChart.PlotArea.Left + (oChart.PlotArea.Width / 2)
oy = oChart.PlotArea.Top + (oChart.PlotArea.Height / 2)
If oSeries.Type = xlPie Or oSeries.Type = xlDoughnut Then
sum = 0
For Each value In oSeries.Values
sum = sum + value
Next
i = 1
angleSoFar = oSeries.Parent.FirstSliceAngle 'Starts from 12h?
For Each oPoint In oSeries.Points
value = oSeries.Values(i)
angleSoFar = AlignSliceLabel(oChart, ox, oy, sum, angleSoFar, CDbl(value), _
i = i + 1
Next
Else
For Each oPoint In oSeries.Points
AlignPointLabel oChart, ox, oy, oPoint, radial
Next
End If
'Error may occur: 'Method 'Position' of object 'DataLabels' failed
On Error Resume Next
oSeries.DataLabels.Position = xlLabelPositionOutsideEnd
End Sub

Private Function AlignSliceLabel#(ch As Chart, ox As Double, oy As Double, sum#, _
angleSoFar As Double, value As Double, oPoint As Point, radial As Boolean)
Dim oDataLabel As DataLabel, slice As Double, deg As Double
On Error Resume Next
Set oDataLabel = oPoint.DataLabel
On Error GoTo 0
If IsObject(oDataLabel) Then
slice = 360 * value / sum
deg = angleSoFar + slice / 2
If deg > 270 Then
deg = deg - 360
ElseIf deg > 180 Then
deg = deg - 180
ElseIf deg > 90 Then
deg = deg - 180
End If
oDataLabel.Orientation = IIf(deg <= 0, -90 - deg, 90 - deg)
Else
'Tangential
oDataLabel.Orientation = 0 - deg
End If
End If
AlignSliceLabel = angleSoFar + slice
End Function

Private Sub AlignPointLabel(ch As Chart, ox As Double, oy As Double, _
oPoint As Point, radial As Boolean)
Dim oDataLabel As DataLabel, rx#, ry#, dx#, dy#, tg As Double, rad#, deg#
On Error Resume Next
Set oDataLabel = oPoint.DataLabel
On Error GoTo 0
If IsObject(oDataLabel) Then
rx = (oPoint.Left + oPoint.Width / 2)
ry = (oPoint.Top + oPoint.Height / 2)
dx = rx - ox
dy = ry - oy
If dx <> 0 Then
tg = dy / dx
deg = rad * 180 / WorksheetFunction.Pi
Else
deg = 90
End If
oDataLabel.Orientation = 0 - deg
Else
'Tangential
oDataLabel.Orientation = _
IIf(0 - deg - 90 >= -90, 0 - deg - 90, 0 - deg + 90)
End If
End If
End Sub
Author
Worf
Views
2,637
First release
Last update
Rating
1 ratings

nice stuff

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back