Ring Chart - Data Label Orientation

IanBWiz

New Member
Joined
Feb 22, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi all.
I have some code below (courtesy of Jon Peltier) that orients data labels in a ring chart based on calculated cell values.
When I apply this code, it works in that it does actually align my data labels in Ring2 but fails due to a run-time error 13.
When I apply the same code to orient the Ring3 data labels, it fails for the same reason but doesn't orient any of the labels.
I've included both sets of Ring code below and a snippet of the worksheet it applies to (note the hidden columns).
Any help in getting both of these sets of code to work without error would be greatly appreciated. Thanks. Ian.

VBA Code:
Sub Ring2AnglesCode()
  ' define the chart (or could use ActiveChart)
  Dim cht As Chart
  Set cht = ActiveSheet.ChartObjects("Ring Chart").Chart
  ' find series formula for second series
  Dim fmla As String
  fmla = cht.SeriesCollection(2).Formula
  ' split series formula to find Y values
  Dim vFmla As Variant
  vFmla = Split(fmla, ",")
  ' range containing Y values
  Dim rYVals As Range
  Set rYVals = Range(vFmla(LBound(vFmla) + 2))
  ' range containing calculated angles, assume it's 20 columns to the right of Y values
  Dim rAngles As Range
  Set rAngles = rYVals.Offset(, 20)
  'put angles into an array
  Dim vAngles As Variant
  vAngles = rAngles.Value2
  ' loop through angles
  Dim iAngle As Long
  For iAngle = 1 To UBound(vAngles, 1)
    ' skip if blank
    If Not IsEmpty(vAngles(iAngle, 1)) Then
      ' reorient each label
      [COLOR=rgb(235, 107, 86)]cht.SeriesCollection(2).DataLabels(iAngle).Orientation = vAngles(iAngle, 1)[/COLOR]
    End If
  Next
End Sub

VBA Code:
Sub Ring3AnglesCode()
  Dim cht As Chart
  Set cht = ActiveSheet.ChartObjects("Ring Chart").Chart
  Dim fmla As String
  fmla = cht.SeriesCollection(3).Formula
  Dim vFmla As Variant
  vFmla = Split(fmla, ",")
  Dim rYVals As Range
  Set rYVals = Range(vFmla(LBound(vFmla) + 2))
  Dim rAngles As Range
  Set rAngles = rYVals.Offset(, 24)
  Dim vAngles As Variant
  vAngles = rAngles.Value2
  Dim iAngle As Long
  For iAngle = 1 To UBound(vAngles, 1)
    If Not IsEmpty(vAngles(iAngle, 1)) Then
      [COLOR=rgb(226, 80, 65)]cht.SeriesCollection(3).DataLabels(iAngle).Orientation = vAngles(iAngle, 1)[/COLOR]
    End If
  Next
End Sub

MrExcel Help.jpg
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,215,061
Messages
6,122,921
Members
449,094
Latest member
teemeren

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