• If you would like to post, please check out the MrExcel Message Board FAQ and click here to register.
    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

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
Excel Version
2013
Author
Worf
Views
729
First release
Last update
Rating
0.00 star(s) 0 ratings

More Excel articles from Worf

Some videos you may like

This Week's Hot Topics

Top