Labels to the right of stacked columns

[chzhd4life]

Trying to automatically (e.g., not manually move one at a time) add labels to the outside right of stacked column chart. Found this old thread with a macro I'm attempting to use but getting an error and don't know enough about macros to figure it out! Here's macro:


Sub Stack()
Dim s As Series, yv, dlt!, lb As DataLabel, i%, j%, ch As Chart, cn
Const adj = -5 ' fine tuning
cn = Array("Chart1") ' desired charts
For j = LBound(cn) To UBound(cn)
Set ch = ActiveSheet.ChartObjects(cn(j)).Chart
If ch.ChartType = 52 Then ' stacked
ch.ChartGroups(1).GapWidth = 100
For i = 1 To ch.SeriesCollection.Count ' all series
Set s = ch.SeriesCollection(i)
yv = s.Values
dlt = (ch.ChartArea.Width / (UBound(yv) * 2)) + adj ' amount of horizontal change
If Not s.HasDataLabels Then s.HasDataLabels = True
For Each lb In s.DataLabels
lb.Left = lb.Left + dlt ' adjust position
Next lb, i
End If
Next
End Sub


Error I get is "The item with the specified name isn't found" and when I debug it lands here: Set ch = ActiveSheet.ChartObjects(cn(j)).Chart

Any ideas GREATLY appreciated!

 

[BSALV]

a lucky guess ??? i think excel expects a string or a number
Set ch = ActiveSheet.ChartObjects(cstr(cn(j))).Chart

 

[chzhd4life]

a lucky guess ??? i think excel expects a string or a number
Set ch = ActiveSheet.ChartObjects(cstr(cn(j))).Chart

Nope, still same error, same part it doesn't like in debugger

 

[Jon Peltier]

Few things.

The error is because of this:

Next lb, i

Which should be

Next lb
Next i

But there are other ways to improve the code.

Dim s As Series, yv, dlt!, lb As DataLabel, i%, j%, ch As Chart, cn

Don't get into the habit of using the one-character shortcuts for variable type, because they are antiquated and many experienced coders (like me) don't remember them. Use the variable types explicitly:

Dim s As Series, yv As Variant, dlt As Single, lb As DataLabel, i As Integer, j As Integer, ch As Chart, cn As Variant

and in fact, you should use Longs and not Integers, and Doubles and not Singles, because of the way VBA processes them:

Dim s As Series, yv As Variant, dlt As Double, lb As DataLabel, i As Long, j As Long, ch As Chart, cn As Variant

and also

Const adj As Double = -5

Use named constants, so change this

If ch.ChartType = 52 Then ' stacked

to this

If ch.ChartType = xlColumnStacked Then

It more accurate documents the code than the comment at the end of the first line.

Also note that the default chart names include a space:

cn = Array("Chart 1")

Blah, blah, blah. Here is my amended routine, which follows my suggestions above, changes variable names and even the procedure name to something more descriptive, and uses a better algorithm to calculate the new data label position.

Sub StackedColumnLabelsToRightOfPoints()
  Dim srs As Series, pt As Point, iSrs As Long, iCht As Long, cht As Chart, ChtList As Variant
  ChtList = Array("Chart 1") ' desired charts
  For iCht = LBound(ChtList) To UBound(ChtList)
    Set cht = ActiveSheet.ChartObjects(ChtList(iCht)).Chart
    If cht.ChartType = xlColumnStacked Then
      cht.ChartGroups(1).GapWidth = 100
      For iSrs = 1 To cht.SeriesCollection.Count ' all series
        Set srs = cht.SeriesCollection(iSrs)
        If Not srs.HasDataLabels Then srs.HasDataLabels = True
        For Each pt In srs.Points
          pt.DataLabel.Left = pt.Left + pt.Width
        Next pt
      Next iSrs
    End If
  Next
End Sub

 

[Jon Peltier]

Even better, the following two procedures process the data labels, but you can easily select which chart or charts you want to process, rather than having to edit the names of the charts in the code.

Select multiple charts by selecting one, then hold Ctrl or Shift while selecting others.

The second procedure does the labels for a specified chart, while the first procedure specifies the active chart, if there is one, or each selected chart, if there are any.

Sub StackedColumnLabelsToRightOfPointsInSelectedCharts()
  If Not ActiveChart Is Nothing Then
    ' active chart
    StackedColumnLabelsToRightOfPoints ActiveChart
  ElseIf TypeName(Selection) = "DrawingObjects" Then
    ' multiple shapes selected
    Dim shp As Shape
    For Each shp In Selection.ShapeRange
      If shp.HasChart Then
        StackedColumnLabelsToRightOfPoints shp.Chart
      End If
    Next
  End If
End Sub

Sub StackedColumnLabelsToRightOfPoints(cht As Chart)
  Dim srs As Series, pt As Point
  If cht.ChartType = xlColumnStacked Then
    cht.ChartGroups(1).GapWidth = 100
    For Each srs In cht.SeriesCollection
      If Not srs.HasDataLabels Then srs.HasDataLabels = True
      For Each pt In srs.Points
        pt.DataLabel.Left = pt.Left + pt.Width
      Next pt
    Next srs
  End If
End Sub

 

[chzhd4life]

YOU ARE THE BEST!!!!!!!!!!!!! Works like a charm!