• If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
  • Excel articles and downloadable files provided in the articles have not been reviewed by MrExcel Publishing. Please apply the provided methods / codes and open the files at your own risk. If you have any questions regarding an article, please use the Article Discussion section.
Worf

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

fig1.JPG


fig2.JPG


fig3.JPG


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), _
        oPoint, radial)
        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
    If radial Then
        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
        rad = Atn(tg)
        deg = rad * 180 / WorksheetFunction.Pi
    Else
        deg = 90
    End If
    If radial Then
        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,714
First release
Last update
Rating
5.00 star(s) 1 ratings

More Excel articles from Worf

Latest reviews

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top