Update Macro to be clear old values, then paste new values

Regular Contributor

To inorder to populate totals on stacked bar charts i have found the following macro.


Note: The routine does not add a column in the worksheet for the totals. Instead, it adds the data in VBA, creating an array of totals, then uses this array rather than a worksheet range to populate series it adds to the chart. This makes it a bit cleaner, and it’s easier than figuring out where in the sheet to put the totals.

 

However, it’s also not dynamic, so if the values change, the labeled totals will no longer be correct. Is there a way to update this, so i can be used again each month?

 

Here’s the routine:

 

Sub AddTotalsToStackedColumnChart()
If ActiveSheet Is Nothing Then GoTo ExitProc
If ActiveChart Is Nothing Then GoTo ExitProc

Dim cht As Chart
Set cht = ActiveChart

If cht.ChartType = xlColumnStacked Then
Dim SeriesCount As Long
SeriesCount = cht.SeriesCollection.Count
Dim PointCount As Long
PointCount = cht.SeriesCollection(1).Points.Count
Dim Totals() As Double
ReDim Totals(1 To PointCount) As Double
Dim SeriesIndex As Long
For SeriesIndex = 1 To SeriesCount
Dim YVals As Variant
YVals = cht.SeriesCollection(SeriesIndex).Values
Dim PointIndex As Long
For PointIndex = 1 To PointCount
If IsNumeric(YVals(PointIndex)) Then
Totals(PointIndex) = Totals(PointIndex) + YVals(PointIndex)
End If
Next
Next

Dim IsAxisBetweenCategories As Boolean
IsAxisBetweenCategories = cht.Axes(xlCategory).AxisBetweenCategories

Dim NewSeries As Series
Set NewSeries = cht.SeriesCollection.NewSeries
With NewSeries
.ChartType = xlLine
.Values = Totals
.Format.Line.Visible = False
.HasDataLabels = True
With .DataLabels
.ShowValue = True
.ShowCategoryName = False
.ShowSeriesName = False
.ShowBubbleSize = False
.ShowPercentage = False
.ShowLegendKey = False
.Position = xlLabelPositionAbove
End With
End With

cht.Axes(xlCategory).AxisBetweenCategories = IsAxisBetweenCategories
cht.Legend.LegendEntries(cht.Legend.LegendEntries.Count).Delete
End If

ExitProc:
End Sub

 

Appreciate the assistance.

 

Kind regards,

0 Replies