Excel: Subtotal and Hierarchy Template and Macro

Sometimes you need to add subtotals based on indents. Something like:

Here is a macro that will do this:

Sub createSubtotalsFromIndents()

' Creates subtotals based on the Outline Level.

' The spreadsheet should have a column titled "Outline Level" for this to work automatically.

' Edward Chan 2022

Dim SubtotalRng As Range

Dim IndentRng As Range

Dim StartCell As Range

Dim EndCell As Range

Dim workrng As Range

Dim HeadingRng As Range

Dim ws As Worksheet

Set ws = ActiveSheet

On Error GoTo quit

Set IndentRng = Application.InputBox("Select the indented titles:", "Indent Range", Application.Selection.Address, Type:=8)

Set SubtotalRng = Application.InputBox("Select region to add subtotals to:", "Subtotal Range", Application.Selection.Address, Type:=8)

On Error GoTo 0

For i = 1 To IndentRng.Rows.Count

If IndentRng.Cells(i, 1).IndentLevel < IndentRng.Cells(i + 1, 1).IndentLevel Then

' subtotal logic here

' Find last cell where the outline number is higher

endCellCount = 0

For j = i + 1 To IndentRng.Rows.Count

If IndentRng.Cells(j, 1).IndentLevel > IndentRng.Cells(i, 1).IndentLevel Then

endCellCount = endCellCount + 1

Else

Exit For

End If

Next j

Set StartCell = SubtotalRng.Cells.Item(i + 1, 1)

Set EndCell = SubtotalRng.Cells.Item(i + endCellCount, 1)

SubtotalRng.Cells(i, 1).Select

If InStr(1, SubtotalRng.Cells(i, 1).Formula, "=SUBTOTAL") Or IsEmpty(SubtotalRng.Cells(i, 1)) Then

SubtotalRng.Cells.Item(i, 1).Value = "=SUBTOTAL(9," & Range(StartCell, EndCell).Address(False, False) & ")"

Else

Result = MsgBox("There is already a value in the selected cell that is not a subtotal. Please remove this value or correct the Outline Level for this row.")

Exit Sub

End If

Next i

quit:

End Sub

Here's something a bit more complex:

If you have an Outline numbered list and values against each entry, it should be easy to add things up in a hierarchical manner so you can figure out how much each level costs easily.

Excel does have a nice "subtotal" formula, but it requires you to manually specify the range to add.

Excel also offers a "SUBTOTAL" button that more or less automates this based on the grouping level. But the "SUBTOTAL" button has the following problems:

It adds extra TOTAL rows instead of using your heading rows.
It deletes whatever summary rows that you've added yourself.
It relies on all your rows being contiguous with no heading rows or blank rows.
It requires your data to already be in a pivot table data format, with each level already added as an extra column.
It doesn't support multi-level indents.
You cannot update values without deleting all TOTAL rows, which may already have your text in it.

Basically this button is only useful if you have a dump from a database without any existing headings or breaks.

So I have written a template with included macros and a ribbon that adds subtotals based on only the numerical outline levels.

It also features outline grouping, and colouring of heading levels.

Each level is indicated by the indenting of the row, using three spaces per indent.

Hierarchical Pivot Table

In addition, the template will also produce a fully hierarchical pivot table to validate all the subtotal figures, and provide rollups if you want to hide subvalues. It uses the H1 ~ H4 columns to do this automatically.

Ribbon

A new ribbon entry called "Hierarchy" appears when you open up the Excel file. This allows you to insert new rows, move and indent tasks, update the formatting, and update subtotals.

NOTE: If you'd like to contribute, to add new buttons, please see the tutorial here: https://stackoverflow.com/questions/8850836/how-to-add-a-custom-ribbon-tab-using-vba

The GUI "Office Custom UI Editor" can be found here: https://github.com/OfficeDev/office-custom-ui-editor/tree/master/publish or here: https://github.com/OfficeDev/office-custom-ui-editor/issues/3

Summary Columns

The Update Subtotals button also checks for any text summary columns, designated with ";;".

This allows text summaries like the following:

NOTE: If you need to allocate multiple resources to a line manually, please use ";" or ",", not a double ";;". The formula will replace any lines with ";;" with a formula. This may result in some duplicate values, however this is the only way to make the formula work in Office 2019. In Office 2021 and above, the "unique" and "textsplit" formulas can be used to eliminate these duplicates, however for backward compatibility I haven't used them.

Notes

If you get an error that your "pivot table cannot update due to automatic subtotals", then clear the outline (Data > Ungroup > Clear Outline). Then click Hierarchy > Format Hierarchy.

TODO

Change Smart Filter to detect if filtering numbers and filter only using that number

INSTALLATION

Press ALT-F11 to open Visual Basic.
Ensure that the following references are enabled: