Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
Sub group_data()
Dim r As Range
Dim v As Variant
Dim i As Long, j As Long
With Sheet1
On Error Resume Next
' expand all groups on sheet
.Outline.ShowLevels RowLevels:=8
' remove any existing groups
On Error GoTo 0
' change B1 to your column
Set r = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp))
End With
With r
'identify common groups in column B
j = 1
v = .Cells(j, 1).Value
For i = 1 To .Rows.Count
If v <> .Cells(i, 1) Then
' Colum B changed, create group
v = .Cells(i, 1)
If i > j + 1 And v <> 0 Then
.Cells(j, 1).Resize(i - j, 1).Rows.Group
ElseIf .Cells(i - 1, 1) = 0 Then
.Cells(i - 1, 1).Rows.Group
End If
j = i
v = .Cells(j, 1).Value
End If
' create last group
If i > j + 1 Then
.Cells(j, 1).Resize(i - j, 1).Rows.Group
End If
' collapse all groups
.Parent.Outline.ShowLevels RowLevels:=1
End With
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.