Fix label position in doughnut chart?

[bigpat]

Hi, I have a simple calculation showing

Target ........1000
Progress ......674
Outstanding...326

and I have a doughnut chart showing the 674 and the 326.

I added a label to the Progress series only and set it to percentage so that it shows 67%. Then I manually moved the label to the centre of the doughnut, made it bold and increased the font size. Hopefully you can visualise that. It's supposed to be a very simple dashboard indicator showing the current percentage, surrounded by the doughnut.

Problem 1: When any of the values change, the position of the label changes too. It does not stay nicely centred in the doughnut.
Problem 2: I can't enlarge it further without having the percentage symbol wrap onto the next line, even though there appears to be plenty of space. When the label is is selected there seems to be drag handles on the corners but they don't seem to do anything.

Is there a way I can fix this? A fairly simple way, preferably. I'm a point-and-click guy, not a coder/developer.

Thanks

 

[pbornemeier]

Add this code to a standard module as outlined in the note in my sig then run the code with the worksheet containing the doughnut chart as the active sheet.

Option Explicit

Sub AddCenterProgressLabelInDoughnutChart()
    'Assumption:
    'To be run on a worksheet containing a doughnut chart that
    'has a single series with 2 points: Target & Progress,
    'each with an associated numeric value

    Dim lPOI As Long
    Dim lPointIndex As Long
    Dim sngPlotWidth As Single
    Dim sngPlotHeight As Single
    Dim sngPlotLeft As Single
    Dim sngPlotTop As Single
    Dim sngDLWidth As Single
    Dim sngDLHeight As Single
    
    'Select the chart on the active sheet
    ActiveSheet.ChartObjects(1).Activate
    
    'Remove existing labels from chart
    ActiveChart.SetElement (msoElementDataLabelNone)
    
    'Add all data labels to series 1
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.ShowCategoryName = True
    Selection.ShowSeriesName = True
    Selection.ShowPercentage = True
    
    'Find which point contains 'Progress'
    For lPointIndex = 1 To ActiveChart.SeriesCollection(1).Points.Count
        If InStr(ActiveChart.SeriesCollection(1).Points(lPointIndex).DataLabel.Text, "Progress") > 0 Then
            lPOI = lPointIndex
        End If
    Next
    
    'Remove existing labels from chart
    ActiveChart.SetElement (msoElementDataLabelNone)
    
    'Add % label to the Progress Point
    ActiveChart.SeriesCollection(1).Points(lPOI).ApplyDataLabels
    ActiveChart.SeriesCollection(1).Points(lPOI).DataLabel.Select
    With Selection
        .ShowPercentage = True
        .ShowValue = False
        .ShowCategoryName = False
        .ShowSeriesName = False
        DoEvents
    End With

    sngDLWidth = Selection.Width
    sngDLHeight = Selection.Height
    
    sngPlotWidth = ActiveChart.PlotArea.Width
    sngPlotHeight = ActiveChart.PlotArea.Height
    sngPlotLeft = ActiveChart.PlotArea.Left
    sngPlotTop = ActiveChart.PlotArea.Top
    
    Selection.Left = sngPlotLeft + sngPlotWidth / 2 - sngDLWidth / 2
    Selection.Top = sngPlotTop + sngPlotHeight / 2 - sngDLHeight / 2
    
    Selection.Format.TextFrame2.TextRange.Font.Size = 24
    Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
    
    ActiveSheet.ChartObjects(1).Activate
    
End Sub

 

[bigpat]

Thank you so much for doing that. So that macro would have to be executed each time the "Progress" value was updated? I imagine there must be a way of getting it to run automatically when the relevant cell is updated, but I think that's a battle for another day.

I'm going to have to rethink the doughnut chart idea though, because I have realised it's not suitable for cases where progress outstrips target. E.g. Target = 1000, Progress = 1100. The doughnut chart still shows two slices, which is misleading. I think I need a gauge chart. Back to the drawing board!

I've learned some syntax here though. That'll be useful - somewhere!

Thanks again

 

[pbornemeier]

Another way to use the doughnut chart. Start with Target Value in B1 and Progress Value in B2, nothing else on worksheet:

Option Explicit

Sub AddCenterProgressLabelInDoughnutChart()
    'Assumption:
    'No chart on worksheet
    'Target values in B1
    'Progress value in B2

    Dim lPOI As Long
    Dim lPointIndex As Long
    Dim sngPlotWidth As Single
    Dim sngPlotHeight As Single
    Dim sngPlotLeft As Single
    Dim sngPlotTop As Single
    Dim sngDLWidth As Single
    Dim sngDLHeight As Single
    Dim lOverCount As Long
    Dim oChart As Object
    Dim sngProgress As Single
    Dim sngTarget As Single
    Dim sngDelta As Single
    Dim sngRemainder As Single
    Dim lOverIndex As Long
    Dim sngRatio As Single
    
    sngTarget = Range("B1").Value
    sngProgress = Range("B2").Value
    sngDelta = sngTarget - sngProgress
    
    'Delete chart if it exists
    On Error Resume Next
    ActiveSheet.Shapes("Status").Delete
    On Error GoTo 0
    
    'Add a chart and select it
    Set oChart = ActiveSheet.Shapes.AddChart
    oChart.Select
    ActiveChart.ChartType = xlDoughnut
    oChart.Name = "Status"
    
    'Add Series
    With ActiveChart
        'If active cell contains data series may be automatically added in new chart
        On Error Resume Next
        For lPointIndex = 1 To .SeriesCollection.Count
            .SeriesCollection(1).Delete
        Next

        'Show Each 100% as a full ring plus a fractiona ring for anything less than 100%
        sngRatio = sngProgress / sngTarget
        
        lOverCount = Int(sngRatio)
        sngRemainder = sngProgress - (CSng(lOverCount) * sngTarget)
        For lOverIndex = 1 To lOverCount
            'Add Full Ring
            .SeriesCollection.NewSeries
            With .SeriesCollection(lOverIndex)
                .Values = "={1}"
            End With
            'Color Full Ring
            .SeriesCollection(lOverIndex).Select
            With Selection.Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 128, 0) 'Green
                .Transparency = 0
                .Solid
            End With
            With Selection.Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 0, 0)   'Black
                .Transparency = 0
                .Weight = 1
            End With
        Next
        If sngRatio - CSng(lOverCount) > 0 Then
            'Add fractional ring
            .SeriesCollection.NewSeries
            With .SeriesCollection(.SeriesCollection.Count)
                .Values = "={" & sngRemainder & "," & sngTarget - sngRemainder & "}"
                '.XValues = "={""Progress"",""Delta""}"
            End With
            
            'Color filled part of fractional ring
            ActiveChart.SeriesCollection(.SeriesCollection.Count).Points(1).Select
            With Selection.Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 128, 0) 'Green
                .Transparency = 0
                .Solid
            End With
            With Selection.Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 0, 0)   'Black
                .Transparency = 0
                .Weight = 1
            End With
            
            'Color Remainder of fractional ring
            ActiveChart.SeriesCollection(.SeriesCollection.Count).Points(2).Select
            With Selection.Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0) 'Red
                .Transparency = 0
                .Solid
            End With
            With Selection.Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 0, 0)   'Black
                .Transparency = 0
                .Weight = 1
            End With
            
        End If
    End With
    
    'Remove existing labels from chart
    ActiveChart.SetElement (msoElementDataLabelNone)
    
    'Don't bother moving label, create a new text box (but left code in since it may be useful)
'    'Add all data labels to series 1
'    ActiveChart.SeriesCollection(1).ApplyDataLabels
'    ActiveChart.SeriesCollection(1).DataLabels.Select
'    Selection.ShowCategoryName = True
'    Selection.ShowSeriesName = True
'    Selection.ShowPercentage = True
'    Selection.ShowValue = True
'
'    'Find which point contains 'Delta'
'    For lPointIndex = 1 To ActiveChart.SeriesCollection(1).Points.Count
'        If InStr(ActiveChart.SeriesCollection(1).Points(lPointIndex).DataLabel.Text, "Delta") > 0 Then
'            lPOI = lPointIndex
'            Selection.ShowCategoryName = False
'            Selection.ShowSeriesName = False
'            Selection.ShowPercentage = False
'            sngDelta = ActiveChart.SeriesCollection(1).Points(lPointIndex).DataLabel.Text
'        End If
'    Next
'
'    'Find which point contains 'Progress'
'    ActiveChart.SeriesCollection(1).DataLabels.Select
'    Selection.ShowCategoryName = True
'    Selection.ShowSeriesName = True
'    Selection.ShowPercentage = True
'    Selection.ShowValue = True
'
'    For lPointIndex = 1 To ActiveChart.SeriesCollection(1).Points.Count
'        If InStr(ActiveChart.SeriesCollection(1).Points(lPointIndex).DataLabel.Text, "Progress") > 0 Then
'            lPOI = lPointIndex
'            Selection.ShowCategoryName = False
'            Selection.ShowSeriesName = False
'            Selection.ShowPercentage = False
'            sngProgress = ActiveChart.SeriesCollection(1).Points(lPointIndex).DataLabel.Text
'        End If
'    Next
'
'    'Remove existing labels from chart
'    ActiveChart.SetElement (msoElementDataLabelNone)
'
'    'Add % label to the Progress Point
'    ActiveChart.SeriesCollection(1).Points(lPOI).ApplyDataLabels
'    ActiveChart.SeriesCollection(1).Points(lPOI).DataLabel.Select
'    With Selection
'        .ShowPercentage = True
'        .ShowValue = False
'        .ShowCategoryName = False
'        .ShowSeriesName = False
'        DoEvents
'    End With
    
    'Add Percent Box
    ActiveChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 180, 180, 100, 40).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Application.WorksheetFunction.Floor(100 * (sngProgress / sngTarget), 1) & "%"
    With Selection.ShapeRange.TextFrame2.TextRange.Characters.Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 24
        .Name = "+mn-lt"
        .Bold = msoTrue
    End With

    Selection.ShapeRange.TextFrame2.MarginLeft = 0
    Selection.ShapeRange.TextFrame2.MarginRight = 0
    Selection.ShapeRange.TextFrame2.MarginTop = 0
    Selection.ShapeRange.TextFrame2.MarginBottom = 0
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    
    'Position Text Box
    sngDLWidth = Selection.Width
    sngDLHeight = Selection.Height
    
    sngPlotWidth = ActiveChart.PlotArea.Width
    sngPlotHeight = ActiveChart.PlotArea.Height
    sngPlotLeft = ActiveChart.PlotArea.Left
    sngPlotTop = ActiveChart.PlotArea.Top
    
    Selection.Left = sngPlotLeft + sngPlotWidth / 2 - sngDLWidth / 2
    Selection.Top = sngPlotTop + sngPlotHeight / 2 - sngDLHeight / 2
    
    ActiveSheet.ChartObjects(1).Activate
    
End Sub

 

[Tom85]

Turn off data labels. Insert a Text box in to the middle of the donut, select the edge of the text box and in the formula bar hit = then select the cell that contains the progress figure. You can format this to however you want it, it will update and it won't move.

 

[bigpat]

Turn off data labels. Insert a Text box in to the middle of the donut, select the edge of the text box and in the formula bar hit = then select the cell that contains the progress figure. You can format this to however you want it, it will update and it won't move.

Oh wow! I always thought text-boxes were just text-boxes. I've been using Excel for maybe 15 years and had no idea you could put a formula in one. You've kind of blown my mind here

As mentioned in this post, I went off the idea of a doughnut chart and figured out a gauge chart instead, but this is a superb tip and I'm definitely going to use it elsewhere.

Thanks so much for posting this.