Adding CAGR line to existing column chart

30 views Asked by At

I'm trying to write code to add a above an existing and selected column chart to illustrate the CAGR in VBA in Powerpoint. I've gotten as writing the following code but I'm not getting the right results:

Sub CAGRTest()

Dim myChart As Chart
Dim chartSeries As Series
Dim mySeries As Series
Dim numPeriods As Integer
Dim CAGR As Double
Dim MaxVal As Double
Dim DistanceFromBar As Double
Dim startPoint As Integer
Dim endPoint As Integer
Dim CAGRLineXValues() As Variant
Dim CAGRLineYValues() As Variant

' Ensure a shape is selected and it contains a chart
If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
If Not ActiveWindow.Selection.ShapeRange(1).HasChart Then Exit Sub

Set myChart = ActiveWindow.Selection.ShapeRange(1).Chart
Set chartSeries = myChart.SeriesCollection(1)
numPeriods = chartSeries.Points.Count
CAGR = ((chartSeries.Values(numPeriods) / chartSeries.Values(1)) ^ (1 / (numPeriods - 1))) - 1

Debug.Print CAGR

' Calculate the maximum value
MaxVal = chartSeries.Values(1)
If chartSeries.Values(numPeriods) > MaxVal Then MaxVal = chartSeries.Values(numPeriods)

Debug.Print MaxVal

DistanceFromBar = MaxVal * (1 + 0.1)

Debug.Print DistanceFromBar

' Calculate CAGR line coordinates
startPoint = 1
endPoint = numPeriods

ReDim CAGRLineXValues(1 To 2)
ReDim CAGRLineYValues(1 To 2)
CAGRLineXValues(1) = startPoint
CAGRLineXValues(2) = endPoint
CAGRLineYValues(1) = DistanceFromBar
CAGRLineYValues(2) = DistanceFromBar

' Add CAGR line as a scatter chart
With myChart.SeriesCollection.NewSeries
    .Name = "CAGR Line"
    .Values = CAGRLineYValues
    .XValues = CAGRLineXValues
    .ChartType = xlXYScatterLines
    .MarkerStyle = xlMarkerStyleNone
End With

End Sub

I'm aiming for thisenter image description here:

Thanks in advance!

0

There are 0 answers