Relative Chart Data Label Positioning

[bs0d]

I have a clustered stacked column chart. The stacked columns are set to 0% gap width, so they actually appear side-by-side rather than on top of each other. This works wells for me, except when it comes to data labels. Because the series are defined as stacked, the option for "outside end" is not available. I would like for the data labels to appear just above each bar. I believe I need to incorporate a VBA routine that sets the label position above the value of the bar because the chart is also dynamic. That is, the data changes based on other selections I make in the workbook. So if I manually drag the labels above the value, they can be wildly out of proportion once the data changes.

Can you still use VBA to apply an outside end position for chart labels even if it's not available through the Excel GUI?

or - Can someone show me an example of a loop that will cycle through the chart series and each value, and set the label position a relative position above the series value, such as value + 5 pixels?

Please let me know if the background or request is unclear in any way.


Thanks,

 

[bs0d]

Here's what I've come up with. At this point, perhaps the community can provide feedback to optimize and make the code more efficient, or propose alternatives:

Sub ModDataLabels()

Application.ScreenUpdating = False
Dim newTop As Long

Sheets("__SHEET NAME___").ChartObjects("___CHART NAME___").Activate

'Remove existing labels:
ActiveChart.SetElement (msoElementDataLabelNone)
        
With ActiveChart
    For x = 1 To .SeriesCollection.Count
            
        'Add labels at known positioning for desired series:
        .FullSeriesCollection(x).HasDataLabels = True
        
        'Format DataLabels:
        With .FullSeriesCollection(x)
            .DataLabels.Position = xlLabelPositionInsideEnd
            .DataLabels.NumberFormat = "#,###;;;"
            .HasLeaderLines = False
            .DataLabels.Font.Bold = True
        End With
  
        'Adjust label position:
        For y = 2 To .FullSeriesCollection(x).Points.Count

            On Error Resume Next 'DataLabels don't exist for each point; skip where appropriate
            
            newTop = .FullSeriesCollection(x).Points(y).DataLabel.Top - 25
            
            'Apply new values:
            .FullSeriesCollection(x).Points(y).DataLabel.Top = newTop
        Next y
    Next x
End With

Application.ScreenUpdating = True
End Sub

 

[bs0d]

duplicate post