- Excel Version
- 2013
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.
This goes in the SHEET level module area. It's for the button that updates the chart
Paste this into a standard module.
Dynamic Waterfall Chart
I'll try to keep this link available as long as possible.
Book1 | |||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | |||
2 | Waterfall Chart Example | ||||||||||||
3 | Chart Title 2 | Series1 | Series2 | Series3 | Series4 | ||||||||
4 | Waterfall Graph Data (DO NOT EDIT) | ||||||||||||
5 | Description | Costs | Costs | Base | Budget | Additions | Reductions | Point | |||||
6 | Previous Cost | 81.2 | 81.2 | - | 81.2 | - | - | 1 | |||||
7 | Non-Recurring Scope | (39.8) | (39.8) | 41.4 | - | - | 39.8 | 2 | |||||
8 | Escalation | 3.7 | 3.7 | 41.4 | - | 3.7 | - | 3 | |||||
9 | New Non-Recurring Scope | 25.6 | 25.6 | 45.1 | - | 25.6 | - | 4 | |||||
10 | New Recurring Costs | 0.3 | 0.3 | 70.7 | - | 0.3 | - | 5 | |||||
11 | Reduction 2 | (3.0) | (3.0) | 68.0 | - | - | 3.0 | 6 | |||||
12 | Reduction 3 | (6.0) | (6.0) | 62.0 | - | - | 6.0 | 7 | |||||
13 | Reduction 4 | (9.0) | (9.0) | 53.0 | - | - | 9.0 | 8 | |||||
14 | Addition 4 | 2.0 | 2.0 | 53.0 | - | 2.0 | - | 9 | |||||
15 | Addition 5 | 4.0 | 4.0 | 55.0 | - | 4.0 | - | 10 | |||||
16 | Contingency | 6.0 | 6.0 | 59.0 | - | 6.0 | - | 11 | |||||
17 | Final | 65.0 | 65.0 | - | 65.0 | - | - | 12 | |||||
18 | |||||||||||||
19 | |||||||||||||
20 | |||||||||||||
21 | |||||||||||||
22 | |||||||||||||
23 | |||||||||||||
24 | Check (Should = 0): | 0.0 | |||||||||||
Cost Comparison |
Cell Formulas | ||
---|---|---|
Range | Formula | |
F6, F7:F23 | F6 | =OFFSET(Costs_hdr,ROW(F6)-ROW($F$5),0) |
H6 | H6 | =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:J23 | J6 | =IF(ROW(J6)-ROW($J$5)<ICount,IF(F6>0,0,-F6),IF(ROW(J6)-ROW($J$5)=ICount,0,"")) |
K6, K7:K23 | K6 | =IF(F6<>0,ROW(K6)-ROW($K$5),"") |
G7 | G7 | =IF(J7>0,H6-J7,H6) |
H7:H23 | H7 | =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:I23 | I7 | =IF(ROW(I7)-ROW($I$5)<ICount,IF(F7>0,F7,0),IF(ROW(I7)-ROW($I$5)=ICount,0,"")) |
G8:G23 | G8 | =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,"")) |
C17 | C17 | =SUM(C6:C16) |
C24 | C24 | =SUM(OFFSET(Costs_hdr,1,0,ICount-1,1))-OFFSET(Costs_hdr,ICount,0) |
Named Ranges | ||
---|---|---|
Name | Refers To | Cells |
Additions | =OFFSET(Additions_hdr,1,0,ICount,1) | I7:I17, G8:G18 |
Additions_hdr | ='Cost Comparison'!$I$5 | I7:I23 |
Base | =OFFSET(Base_hdr,1,0,ICount,1) | G8:G18 |
Base_hdr | ='Cost Comparison'!$G$5 | G8:G23 |
Budget | =OFFSET(Budget_hdr,1,0,ICount,1) | G7, H6:H17 |
Budget_hdr | ='Cost Comparison'!$H$5 | H6:H23 |
Costs_hdr | ='Cost Comparison'!$C$5 | F6:F23, C24 |
ICount | ='Cost Comparison'!$C$25 | J6, H6:H7, I7:J7, G8:J23, C24 |
Reductions | =OFFSET(Reductions_hdr,1,0,ICount,1) | J6:J17, G7:G18 |
Reductions_hdr | ='Cost Comparison'!$J$5 | J6:J23 |
Cells with Conditional Formatting | ||||
---|---|---|---|---|
Cell | Condition | Cell Format | Stop If True | |
C6:C23 | Expression | =AND(ROW(C6)-ROW($C$5)>1,ROW(C6)-ROW($C$5)<ICount,C6>0) | text | YES |
C6:C23 | Expression | =AND(ROW(C6)-ROW($C$5)>1,ROW(C6)-ROW($C$5)<ICount,C6<0) | text | NO |
C24 | Cell Value | <>0 | text | NO |
C24 | Cell Value | =0 | text | NO |
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.