• If you would like to post, please check out the MrExcel Message Board FAQ and click here to register.
    If you forgot your password, you can reset your password.
  • Excel articles and downloadable files provided in the articles have not been reviewed by MrExcel Publishing. Please apply the provided methods / codes and open the files at your own risk.
    If you have any questions regarding an article, please use the Article Discussion section.
Jeffrey Mahoney

Waterfall Chart Automated

Awhile ago I was working for a company managing their budgets. My boss knew I was good with Excel and sent me a copy of a waterfall chart that was created by another person no longer employed by them. Apparently a few people tried to make changes to the chart to reflect the current budget and failed. I thought, because I had created thousands of charts before this, that I was going to return the update in a matter of minutes. I was wrong. I bashed the numbers into place after looking at the monster from every angle. It didn't seem intuitive. Over the next few weeks I was asked to make more changes; each change took me up to 30 minutes based on the amount of changes. It wasn't too hard to make value changes, but it was hard to add or subtract the number of items. I ended up with this. It can handle anywhere from 3 to 18 items. The chart ranges are dynamic based on the count of Descriptions. The macro makes all of the data label changes. It also reduces the font size depending on the number of items.

Book1
ABCDEFGHIJK
2Waterfall Chart Example
3Chart Title 2Series1Series2Series3Series4
4Waterfall Graph Data (DO NOT EDIT)
5DescriptionCostsCostsBaseBudgetAdditionsReductionsPoint
6Previous Cost81.2 81.2 - 81.2 - - 1
7Non-Recurring Scope(39.8) (39.8) 41.4 - - 39.8 2
8Escalation3.7 3.7 41.4 - 3.7 - 3
9New Non-Recurring Scope25.6 25.6 45.1 - 25.6 - 4
10New Recurring Costs0.3 0.3 70.7 - 0.3 - 5
11Reduction 2(3.0) (3.0) 68.0 - - 3.0 6
12Reduction 3(6.0) (6.0) 62.0 - - 6.0 7
13Reduction 4(9.0) (9.0) 53.0 - - 9.0 8
14Addition 42.0 2.0 53.0 - 2.0 - 9
15Addition 54.0 4.0 55.0 - 4.0 - 10
16Contingency6.0 6.0 59.0 - 6.0 - 11
17Final65.0 65.0 - 65.0 - - 12
18
19
20
21
22
23
24Check (Should = 0):0.0
Cost Comparison
Cell Formulas
RangeFormula
F6, F7:F23F6=OFFSET(Costs_hdr,ROW(F6)-ROW($F$5),0)
H6H6=IF(OR(ROW(H6)-ROW($H$5)=1,ROW(H6)-ROW($H$5)=ICount),C6,IF(AND(ROW(H6)-ROW($H$5)>1,ROW(H6)-ROW($H$5)<ICount),0,""))
J6, J7:J23J6=IF(ROW(J6)-ROW($J$5)<ICount,IF(F6>0,0,-F6),IF(ROW(J6)-ROW($J$5)=ICount,0,""))
K6, K7:K23K6=IF(F6<>0,ROW(K6)-ROW($K$5),"")
G7G7=IF(J7>0,H6-J7,H6)
H7:H23H7=IF(OR(ROW(H7)-ROW($H$5)=1,ROW(H7)-ROW($H$5)=ICount),F7,IF(AND(ROW(H7)-ROW($H$5)>1,ROW(H7)-ROW($H$5)<ICount),0,""))
I7:I23I7=IF(ROW(I7)-ROW($I$5)<ICount,IF(F7>0,F7,0),IF(ROW(I7)-ROW($I$5)=ICount,0,""))
G8:G23G8=IF(ROW(G8)-ROW($G$5)<ICount,IF(AND(I8>0,J7>0),G7,IF(AND(I7>0,J8>0),G7+I7-J8,IF(AND(J8>0,J7>0),G7-J8,G7+I7))),IF(ROW(G8)-ROW($G$5)=ICount,0,""))
C17C17=SUM(C6:C16)
C24C24=SUM(OFFSET(Costs_hdr,1,0,ICount-1,1))-OFFSET(Costs_hdr,ICount,0)
Named Ranges
NameRefers ToCells
Additions=OFFSET(Additions_hdr,1,0,ICount,1)I7:I17, G8:G18
Additions_hdr='Cost Comparison'!$I$5I7:I23
Base=OFFSET(Base_hdr,1,0,ICount,1)G8:G18
Base_hdr='Cost Comparison'!$G$5G8:G23
Budget=OFFSET(Budget_hdr,1,0,ICount,1)G7, H6:H17
Budget_hdr='Cost Comparison'!$H$5H6:H23
Costs_hdr='Cost Comparison'!$C$5F6:F23, C24
ICount='Cost Comparison'!$C$25J6, H6:H7, I7:J7, G8:J23, C24
Reductions=OFFSET(Reductions_hdr,1,0,ICount,1)J6:J17, G7:G18
Reductions_hdr='Cost Comparison'!$J$5J6:J23
Cells with Conditional Formatting
CellConditionCell FormatStop If True
C6:C23Expression=AND(ROW(C6)-ROW($C$5)>1,ROW(C6)-ROW($C$5)<ICount,C6>0)textYES
C6:C23Expression=AND(ROW(C6)-ROW($C$5)>1,ROW(C6)-ROW($C$5)<ICount,C6<0)textNO
C24Cell Value<>0textNO
C24Cell Value=0textNO


1575325329070.png

This goes in the SHEET level module area. It's for the button that updates the chart
VBA Code:
Private Sub RefreshDataLabels_btn_Click()
  Call Main.ChartLabelsRefresh
End Sub
Paste this into a standard module.
VBA Code:
Sub ChartLabelsRefresh()

  Dim Sht As Worksheet
  Dim X As Long
  Dim iCnt As Long
  Dim Y As Long
  Dim idx() As Integer
  Dim R As Range
  Dim Cel As Range
  Dim Chrt As ChartObject
  Dim SC As Series
  Dim aChrt As ChartObject
  Dim PrevCel As Range
 
 
  Set Sht = ActiveSheet
  Sht.Unprotect               'I have the sheet protected without a password
                              'so people don't edit the wrong area
  Set PrevCel = ActiveCell    'Store the selected cells
 
  iCnt = Range("ICount").Value                          'Count of points on Waterfall Chart
  ReDim idx(1 To iCnt)                                  'Index to store which series a point belongs
  Set Cel = Range("Costs_hdr")
  Set R = Range(Cel.Offset(1, 0), Cel.Offset(iCnt, 0))
  X = 0
  For Each Cel In R                                      'Get each value and determine which series
    X = X + 1
    If X = 1 Or X = iCnt Then                            'First point or Last Point belong to series 2
      idx(X) = 2
    ElseIf Cel.Value < 0 Then                            'Negative points belong to series 4
      idx(X) = 4
    ElseIf Cel.Value > 0 Then                            'Positive points belong to series 3
      idx(X) = 3
    End If
  Next Cel
 
                  'You will have to change this based on your chart name
  Sht.ChartObjects("Chart 3").Activate
 
  'Delete all datalabels before adding them back in
  For X = 2 To 4
    Set SC = ActiveChart.SeriesCollection(X)
    If SC.HasDataLabels = True Then
      SC.DataLabels.Delete
    End If
  Next X
 
  'Add datalabels for each series
  'Delete series datalabels from non-related points
  'Use idx() to check wich series each point belongs
  For Y = 2 To 4
    Set SC = ActiveChart.SeriesCollection(Y)
    SC.ApplyDataLabels ShowValue:=True
    SC.HasDataLabels = True
    
    With SC.DataLabels.Format.TextFrame2.TextRange.Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 0, 0)
      .Transparency = 0
      .Solid
    End With
    
    For X = 1 To iCnt
      If idx(X) <> Y Then
        SC.Points(X).DataLabel.Delete
      End If
    Next X
  Next Y
 
  'Resize fonts based on the number of axes
  Select Case iCnt
    Case Is > 16
      ActiveChart.Axes(xlCategory).TickLabels.Font.Size = 7
    Case Is > 13
      ActiveChart.Axes(xlCategory).TickLabels.Font.Size = 9
    Case Is > 10
      ActiveChart.Axes(xlCategory).TickLabels.Font.Size = 11
    Case Is > 7
      ActiveChart.Axes(xlCategory).TickLabels.Font.Size = 12
    Case Is <= 7
      ActiveChart.Axes(xlCategory).TickLabels.Font.Size = 13
  End Select
 
  'Make the sheet protected again
  With Sht
    .EnableOutlining = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True _
      , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
      AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, AllowFiltering _
    :=True, userInterfaceOnly:=True
  End With
 
  'Select the cells the user had selected
  PrevCel.Select
    
    
    
End Sub
Dynamic Waterfall Chart
I'll try to keep this link available as long as possible.
Excel Version
2013
  • Like
Reactions: dataluver
Author
Jeffrey Mahoney
Views
649
First release
Last update
Rating
0.00 star(s) 0 ratings

Some videos you may like

This Week's Hot Topics

Top