Jeffrey Mahoney
Well-known Member
- Joined
- May 31, 2015
- Messages
- 2,773
- Office Version
- 365
- Platform
- Windows
I want to share a Waterfall Chart I created. A waterfall chart shows beginning and ending budgets with all the additions and reductions in between. The bars seem like they're floating. The spreadsheet allows the user to enter in the Descriptions and Costs with up to 18 points of budget alteration. There is a table that creates the series data for the chart.
If you've ever been asked to create one of these, I'm sure you know how much of a headache this is.
I'm going to give you the spreadsheet formulas and the VBA code to alter the chart. There is VBA code because of the data labels. On this type of chart, data labels are not easy to maintain when there are a fluctuating number of points. Part of the code also changes the X category font size depending on the number of cost points. I put a "Refresh Chart" button on the sheet to run the macro.
I'm going to provide a copy of this workbook as a link to my Google Drive. I'm not making any guarantees how long it will remain there.
https://drive.google.com/file/d/0B-iOpP_9yRXQbnBYTnZlbDd2RU0/view?usp=sharing
If you like this, please post to this thread. I welcome any suggestions.
Jeff
These are for the user to edit the chart titles
Excel 2010
<tbody>
</tbody>
This is the table where the user enters the Descriptions and Costs
Excel 2010
<tbody>
</tbody>
<tbody>
</tbody>
<tbody>
</tbody> PCount ='Cost Comparison'!$C$26
This is the table that the chart refers to get all the data
Excel 2010
<tbody>
</tbody>
<tbody>
</tbody>
<tbody>
</tbody>
These are all the named ranges that are on this sheet.
<tbody>
</tbody>
<tbody>
</tbody>
Now for the graph series
Series one Name: ='Cost Comparison'!$G$5
Series one values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Base
Series two name: ='Cost Comparison'!$H$5
Series two values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Budget
Series three name: ='Cost Comparison'!$I$5
Series three values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Additions
Series four name: ='Cost Comparison'!$J$5
Series four values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Reductions
Horizontal Axis (X) names: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Descriptions
Notice the name of the workbook in the "Values". You will need to change that to the name of your workbook.
You will need to format series one fill to "No Fill" and border color to "No Line".
Here is the code to change the data labels. This one SUB took me most of a day to complete.
If you've ever been asked to create one of these, I'm sure you know how much of a headache this is.
I'm going to give you the spreadsheet formulas and the VBA code to alter the chart. There is VBA code because of the data labels. On this type of chart, data labels are not easy to maintain when there are a fluctuating number of points. Part of the code also changes the X category font size depending on the number of cost points. I put a "Refresh Chart" button on the sheet to run the macro.
I'm going to provide a copy of this workbook as a link to my Google Drive. I'm not making any guarantees how long it will remain there.
https://drive.google.com/file/d/0B-iOpP_9yRXQbnBYTnZlbDd2RU0/view?usp=sharing
If you like this, please post to this thread. I welcome any suggestions.
Jeff
These are for the user to edit the chart titles
Excel 2010
| B | C | D | |
|---|---|---|---|
| 2 | Waterfall Chart Example | ||
| 3 | Chart Title 2 |
<tbody>
</tbody>
Cost Comparison
This is the table where the user enters the Descriptions and Costs
Excel 2010
| B | C | |
|---|---|---|
| 5 | Description | Costs |
| 6 | Previous Cost | 81.2 |
| 7 | Non-Recurring Scope | (39.8) |
| 8 | Escalation | 3.7 |
| 9 | New Non-Recurring Scope | 25.6 |
| 10 | New Recurring Costs | 0.3 |
| 11 | Reduction 2 | (3.0) |
| 12 | Reduction 3 | (6.0) |
| 13 | Reduction 4 | (9.0) |
| 14 | Addition 4 | 2.0 |
| 15 | Addition 5 | 4.0 |
| 16 | Addition 6 | 6.0 |
| 17 | Final | 65.0 |
| 18 | ||
| 19 | ||
| 20 | ||
| 21 | ||
| 22 | ||
| 23 | ||
| 24 | Check (Should = 0): | 0.0 |
| 25 | Number of Items: | 12.0 |
| 26 | Number of Possible Items: | 18.0 |
| 27 |
<tbody>
</tbody>
Cost Comparison
Worksheet Formulas
<tbody> </tbody> |
<tbody>
</tbody>
Workbook Defined Names
<tbody> </tbody> |
<tbody>
</tbody>
This is the table that the chart refers to get all the data
Excel 2010
| F | G | H | I | J | K | |
|---|---|---|---|---|---|---|
| 3 | Series1 | Series2 | Series3 | Series4 | ||
| 4 | Waterfall Graph Data (DO NOT EDIT) | |||||
| 5 | Costs | Base | Budget | Additions | Reductions | Point |
| 6 | 81.2 | - | 81.2 | - | - | 1 |
| 7 | (39.8) | 41.4 | - | - | 39.8 | 2 |
| 8 | 3.7 | 41.4 | - | 3.7 | - | 3 |
| 9 | 25.6 | 45.1 | - | 25.6 | - | 4 |
| 10 | 0.3 | 70.7 | - | 0.3 | - | 5 |
| 11 | (3.0) | 68.0 | - | - | 3.0 | 6 |
| 12 | (6.0) | 62.0 | - | - | 6.0 | 7 |
| 13 | (9.0) | 53.0 | - | - | 9.0 | 8 |
| 14 | 2.0 | 53.0 | - | 2.0 | - | 9 |
| 15 | 4.0 | 55.0 | - | 4.0 | - | 10 |
| 16 | 6.0 | 59.0 | - | 6.0 | - | 11 |
| 17 | 65.0 | - | 65.0 | - | - | 12 |
| 18 | ||||||
| 19 | ||||||
| 20 | ||||||
| 21 | ||||||
| 22 | ||||||
| 23 |
<tbody>
</tbody>
Cost Comparison
Worksheet Formulas
<tbody> </tbody> |
<tbody>
</tbody>
Workbook Defined Names
<tbody> </tbody> |
<tbody>
</tbody>
These are all the named ranges that are on this sheet.
Workbook Defined Names
<tbody> </tbody> |
<tbody>
</tbody>
Worksheet Defined Names
<tbody> </tbody> |
<tbody>
</tbody>
Now for the graph series
Series one Name: ='Cost Comparison'!$G$5
Series one values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Base
Series two name: ='Cost Comparison'!$H$5
Series two values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Budget
Series three name: ='Cost Comparison'!$I$5
Series three values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Additions
Series four name: ='Cost Comparison'!$J$5
Series four values: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Reductions
Horizontal Axis (X) names: ='Waterfall Chart with Automatic 3 to 18 Points.xlsm'!Descriptions
Notice the name of the workbook in the "Values". You will need to change that to the name of your workbook.
You will need to format series one fill to "No Fill" and border color to "No Line".
Here is the code to change the data labels. This one SUB took me most of a day to complete.
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
Set PrevCel = ActiveCell
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
Sht.ChartObjects("Chart 3").Activate
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
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
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
PrevCel.Select
End Sub
