How to automatically nest rows of an Excel spreadsheet using level values? - excel

Question

I am attempting to apply grouping to an Excel 2016 spreadsheet so that it can be more easily viewed and interpreted. The data in the spreadsheet is in a format similar to the following:
A B C
1 1 x y
2 1 x z
3 2 y y
4 2 x z
5 2 z x
6 1 x y
Column A already contains the numbers corresponding to the nesting levels I want in my spreadsheet i.e. rows 3, 4 and 5 are "children" of row 2, so should be grouped together accordingly. The highest level reached in this particular spreadsheet is 5. I do not need to have any further interaction between rows in the spreadsheet, such as calculating subtotals. The spreadsheet is approximately 800 lines and a good solution will be used elsewhere, so doing this manually is not an ideal solution.
How can I get the group function in Excel 2016 to recognise Column A as my grouping and apply the outline accordingly?

Answer 1

This VBA script has been updated to include more levels of grouping.
It will do what you have requested, grouping rows to the row above, based on the increment number.
How it works is explained as comments within the script, including what could cause a possible failure.
Just to note it will fail if anything other than a number is in column A and also if it does not meet the criteria specified in the example comments.
Sub GroupRanges()
' Group levels must start at one and increase by one for each group level
' An error is produced if any levels are skipped
' Excel can only handle eight groups, the script will give a message and end if there are more than eight level groups
' Example: 1 1 2 3 3 4 4 5 will work
' Example: 1 1 2 2 2 4 4 5 will fail and produce an error, in this case group level 3 was skipped.
' Example: 1 2 3 4 5 6 7 8 9 Will fail, too many levels (more than 8)
Dim Sht As Worksheet
Dim LastRow As Long
Dim CurRow As Long
Dim StartRng As Integer
Dim EndRng As Integer
Dim GrpLvl As Integer
Dim MaxLvl As Integer
' This can be changed to define a sheet name
Set Sht = ActiveSheet
' find the highest number in the range to set as a group level
MaxLvl = WorksheetFunction.Max(Range("A:A"))
' If the Max level is greater than 8, then end the script as grouping cannot go beyond 8 levels
If MaxLvl >= 9 Then
MsgBox "You have " & MaxLvl & " group levels, Excel can only handle up to eight groups. This script will now end."
Exit Sub ' end the script if above eight groups
End If
'Set the Starting Group Level.
GrpLvl = 2
' find the last used row
LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
' Change the grouping to the cell above the range
Sht.Outline.SummaryRow = xlAbove
' Remove existing groups to prevent unrequired group levels.
' We now need to suppress error massages when trying to remove group levels that may not exist.
On Error Resume Next ' disable error messages
For x = 1 To 10 ' Repeat 10 times
Sht.Rows.Ungroup ' Remove Groups
Next x
On Error GoTo 0 ' Now it is important re-enable error messages
' Start the first loop to go through for each group level
For y = 2 To MaxLvl
'Reset the variables for each group level pass
CurRow = 1
StartRng = 0
EndRng = 0
' Start the inner loop through each row
For Z = 1 To LastRow
' Check value of cell, if value is 1 less than current group level then clear the Start/End Range Values
If Sht.Range("A" & CurRow) = GrpLvl - 1 Then
StartRng = 0
EndRng = 0
End If
' If cell value equals the group level then set Range Values accordingly
If Sht.Range("A" & CurRow) >= GrpLvl Then
' Check if row is the first of the range
If Sht.Range("A" & CurRow - 1) = GrpLvl - 1 Then
StartRng = CurRow
End If
' Check if row is the Last of the range
If Sht.Range("A" & CurRow + 1) <= 1 Then
EndRng = CurRow
End If
' If both range values are greater than 0 then group the range
If StartRng > 0 And EndRng > 0 Then
Sht.Rows(StartRng & ":" & EndRng).Rows.Group
End If
End If
CurRow = CurRow + 1 ' increase for the next row
Next Z ' repeat the inner loop
' Increase to the next group Level
GrpLvl = GrpLvl + 1
Next y ' repeat the first loop
End Sub