Doughnut chart plot area shrinks on its whim dynamically

Question

I know I am making a mistake somewhere but I don't know where. Let me explain my problem.

So, I have a table with data for the charts like below:

The vba code will dynamically generate charts like below:

However, as I change the "% Done" values in column B in the table, and generate the charts, for some reason, the plot area is getting shrunk and the doughnut size increasing randomly.

Here is the code I have:

Sub TeamStatsReport()


Dim iStart As Integer, iSprintCount As Integer, iProgramIncrement As Integer, iSprint As Integer
Dim bLoop As Boolean, bSprintFound As Boolean, bActiveSprint As Boolean, bFutureSprint As Boolean
Dim sCurrentSprint As String, sNextSprint As String, sCurrentSprintID As String, sNextSprintID As String, sActiveSprint As String
Dim Counter As Long, ws As Worksheet, zChartSet As ChartObject, colPos As Long, rowNumber As Long

j = 4
Set SprintsDict = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet

Const numChartsPerRow = 4
Const TopAnchor As Long = 8
Const LeftAnchor As Long = 450
Const HorizontalSpacing As Long = 3
Const VerticalSpacing As Long = 3
Const ChartHeight As Long = 115
Const ChartWidth As Long = 170
Counter = 0



For Each zChartSet In ws.ChartObjects
    zChartSet.Delete
Next zChartSet

While j < 12
    ActiveSheet.Shapes.AddChart2(251, xlDoughnut).Select
    ActiveChart.SetSourceData Source:=Worksheets("Infra Team Stats_").Range("B" & j & ":C" & j)
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.FullSeriesCollection(1).Delete
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = "=""series1"""
    ActiveChart.FullSeriesCollection(1).Values = "={1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}"
         
         
    ActiveChart.ChartTitle.Select
    Selection.Caption = Worksheets("Infra Team Stats_").Range("A" & j) & " - " & Format(Worksheets("Infra Team Stats_").Range("B" & j), "0%")


    ActiveChart.FullSeriesCollection(1).Select  
    ActiveChart.ChartGroups(1).DoughnutHoleSize = 40

    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.0500000007
        .Solid
    End With

    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.5
        .Transparency = 0
        .Solid
    End With
    
    ActiveChart.FullSeriesCollection(1).Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(2).Name = Worksheets("Infra Team Stats_").Range("A" & j)
    ActiveChart.FullSeriesCollection(2).Values = Worksheets("Infra Team Stats_").Range("B" & j & ":C" & j)
     
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).AxisGroup = 2
     
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).Points(1).Select
    Selection.Format.Fill.Visible = msoFalse
     
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).Points(2).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.0500000007
        .Transparency = 0
        .Solid
    End With
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0.1999999881
        .Solid
    End With
    ActiveChart.SetElement (msoElementLegendNone)
    
    ActiveChart.PlotArea.Select
    Selection.Width = 220
    Selection.Height = 120
    With ActiveChart
     .PlotArea.Left = (.ChartArea.Width - .PlotArea.Width) / 2
     .PlotArea.Top = (.ChartArea.Height - .PlotArea.Height) / 2
    End With

    j = j + 1
Wend

For Each zChartSet In ws.ChartObjects
    rowNumber = Int(Counter / numChartsPerRow)
    colPos = Counter Mod numChartsPerRow

    With zChartSet
        .Top = TopAnchor + rowNumber * (VerticalSpacing + ChartHeight)
        .Left = LeftAnchor + colPos * (HorizontalSpacing + ChartWidth)
        .Height = ChartHeight
        .Width = ChartWidth
    End With

    Counter = Counter + 1
Next zChartSet
End Sub

Answer 1

The code works although it could be designed better, i.e. create all graphs the first time and then only the one whose data changes. It took some "tricks" to make it work. To take advantage of the plot's internal space we must first shrink the PlotArea and place it in the corner, then set one of its dimensions, because the other always follows the size automatically. Another inexplicable thing is that if you call TeamStatsReport through a Worksheet_Change then before the call we have to move the focus to a cell outside the data area because otherwise an error is generated.

'THIS CODE IN THE SHEET
Option Explicit

Private Sub TeamStatsReport()
   Dim J As Long, Counter As Long, colPos As Long, rowNumber As Long, cc As Integer
   Dim zChartSet As ChartObject
   
   Const numChartsPerRow = 4
   Const TopAnchor As Long = 8
   Const LeftAnchor As Long = 200
   Const HorizontalSpacing As Long = 3
   Const VerticalSpacing As Long = 3
   Const ChartHeight As Long = 130
   Const ChartWidth As Long = 110
   
   On Error GoTo Lerr
   Application.Interactive = False
   Counter = 0
   J = 4
   
   For Each zChartSet In Me.ChartObjects
       zChartSet.Delete
   Next zChartSet
   
   While J < 12
   ActiveSheet.Shapes.AddChart2(251, xlDoughnut).Select
      With ActiveChart
         .ChartArea.Height = ChartHeight
         .ChartArea.Width = ChartWidth
         .SetSourceData Source:=Me.Range("B" & J & ":C" & J)
         .FullSeriesCollection(1).Select
         .FullSeriesCollection(1).Delete
         .SeriesCollection.NewSeries
         .FullSeriesCollection(1).Name = "=""series1"""
         .FullSeriesCollection(1).Values = "={1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}"
         '.ChartTitle.Select
         .ChartTitle.Caption = Me.Range("A" & J) & " - " & Format(Me.Range("B" & J), "0%")
         .FullSeriesCollection(1).Select
      End With
      With Selection.Format.Fill
         .Visible = msoTrue
         .ForeColor.ObjectThemeColor = msoThemeColorAccent1
         .ForeColor.TintAndShade = 0
         .ForeColor.Brightness = -0.5
         .Transparency = 0
         .Solid
      End With
   
      ActiveChart.SeriesCollection.NewSeries
      With ActiveChart.FullSeriesCollection(2)
         .Name = Me.Range("A" & J)
         .Values = Me.Range("B" & J & ":C" & J)
         '.Select
         .AxisGroup = 2
         '.Select
         .Points(1).Select
         Selection.Format.Fill.Visible = msoFalse
         .Points(2).Select
      End With
      
      With Selection.Format.Fill
         .Visible = msoTrue
         .ForeColor.ObjectThemeColor = msoThemeColorBackground1
         .ForeColor.TintAndShade = 0
         .ForeColor.Brightness = 0
         .Transparency = 0.1999999881
         .Solid
      End With
      
      With ActiveChart
         .SetElement (msoElementLegendNone)
         .PlotArea.Select
         .PlotArea.Left = 1
         .PlotArea.Top = 1
         .PlotArea.Width = 1
         .PlotArea.Height = (.ChartArea.Height * 0.99) - .ChartTitle.Height
         .PlotArea.Left = (.ChartArea.Width - .PlotArea.Width) / 2
         .PlotArea.Top = (.ChartArea.Height - .PlotArea.Height + .ChartTitle.Height) / 2
      End With
      
      J = J + 1
   Wend

   For Each zChartSet In Me.ChartObjects
      rowNumber = Int(Counter / numChartsPerRow)
      colPos = Counter Mod numChartsPerRow
      
      With zChartSet
         .Top = TopAnchor + rowNumber * (VerticalSpacing + ChartHeight)
         .Left = LeftAnchor + colPos * (HorizontalSpacing + ChartWidth)
         .Height = ChartHeight
         .Width = ChartWidth
         For cc = 1 To .Chart.ChartGroups.Count
            .Chart.ChartGroups(cc).DoughnutHoleSize = linear_interpolation(280, 75, 85, 46, minOf(.Chart.ChartArea.Width, .Chart.ChartArea.Height))
         Next
      End With
      Counter = Counter + 1
   Next zChartSet
Lerr:
   On Error GoTo 0
   Application.Interactive = True
   Me.Range("A1").Select
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("LDATA")) Is Nothing Then
   'next line is critical. If don't move selection out of the
   'SourceData  (.SetSourceData Source:=Me.Range("B" & J & ":C" & J))
   'the code in the TeamStatsReport Sub generates an error
      Me.Range("A1").Select
      Call TeamStatsReport
      Target.Select
   End If
End Sub


'AND THIS IN A MODULE
Public Function minOf(a As Variant, b As Variant) As Variant
   If (a < b) Then minOf = a Else minOf = b
End Function

Public Function linear_interpolation(x1 As Double, y1 As Double, x2 As Double, y2 As Double, ByVal x As Double) As Double
   If (x2 - x1) = 0 Then   'division by zero
      linear_interpolation = 0#  'or anything else...maybe y1 or y2 ...
   Else
      linear_interpolation = y1 + (((x - x1) * (y2 - y1)) / (x2 - x1))
   End If
End Function

Private Sub CommandButton1_Click()
   'you need the next line.The selected cell must be outside the data area, otherwise an error occurs
   Me.Range("A1").Select  'A1 or any cell out of the data range
   Call TeamStatsReport
End Sub

I WROTE IN HEADER OF ANSWER: THIS CODE IN THE SHEET Copy TeamStatsReport in the Sheet's module NO IN MODULE3 or any other. Take a look in the code above how to modify the CommandButton1_Click...