WaterFall Chart - Up/Down Bars
Hi everyone,
I am creating a waterfall chart with vba, and to do that I was in the process of creating up/down bars between 2 data lines in my chart. However, the code is not cooperating.
The initial data I am using is:
| Category |
Value Gain/Loss |
| PP/E Income |
$1,000,000.00 |
| Claims Handling Expenses |
-$200,000.00 |
| Service Expenses |
-$150,000.00 |
| Risk Control Expenses |
-$250,000.00 |
| Risk Control Fee Income |
$60,000.00 |
| Actuarial Expenses |
-$500,000.00 |
| General Operating Expenses |
-$80,000.00 |
| Investment Income |
$350,000.00 |
My code is:
Sub WaterfallChartToday()
'this part will cut any irrelevant or blank lines from "Enter Values" sheet
Dim FirstRow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim DataRange As Range
Sheets("Enter Values").Activate
Range("A1").Select
FirstRow = Cells(1).Row
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For Lrow = FirstRow To LastRow Step -1
If Cells(Lrow, "A").Value = "" Then
ActiveCell.EntireRow.Delete
End If
Next Lrow
'Select fields to copy and paste
Set DataRange = Range("A1:B" & LastRow)
'this part will paste the now-parsed data into a clean worksheet
DataRange.Select
Selection.Copy
Sheets.Add.Name = "Data Fields"
Worksheets("Data Fields").Activate
ActiveSheet.PasteSpecial
'Set same variables for Data Fields sheet
Dim FirstRow2 As Long
Dim LastRow2 As Long
Dim Lrow2 As Long
FirstRow2 = Cells(1).Row
LastRow2 = Cells(Rows.Count, "A").End(xlUp).Row
For Lrow2 = FirstRow2 To LastRow2 Step -1
If Cells(Lrow2, "A").Value = "" Then
ActiveCell.EntireRow.Delete
End If
Next Lrow2
Range("C1") = "Ends"
Range("D1") = "Before"
Range("E1") = "After"
Range("C2") = Range("B2")
Range("C10") = "=SUM(B2:B9)"
Range("D3") = "=SUM(B$2:B2)"
Range("D3").AutoFill Destination:=Range("D3:D" & LastRow2)
Range("E3") = "=SUM(B$2:B3)"
Range("E3").AutoFill Destination:=Range("E3:E" & LastRow2)
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Set Rng1 = Range("C2:C10")
Set Rng2 = Range("D3:D" & LastRow2 + 1)
Set Rng3 = Range("E3:E" & LastRow2 + 1)
Charts.Add
With ActiveChart
.Name = "Chart 1"
.ChartType = xlLine
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "Before"
ActiveChart.SeriesCollection(1).Values = Rng2.Offset(-1, 0)
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "After"
ActiveChart.SeriesCollection(2).Values = Rng3.Offset(-1, 0)
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "Start"
ActiveChart.SeriesCollection(3).Values = Rng1
ActiveChart.SetElement (msoElementUpDownBarsShow)
ActiveChart.ChartGroups(1).HasUpDownBars = True
ActiveChart.ChartGroups(1).UpBars.Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Solid
End With
Selection.Format.Line.Visible = msoTrue
ActiveChart.ChartGroups(1).DownBars.Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Solid
End With
Selection.Format.Line.Visible = msoTrue
End With
End Sub
The code runs into an error on the line "ActiveChart.ChartGroups(1).UpBars.Select". I'm not sure what the issue is. Any help is greatly appreciated!
Thanks
