Hello (firtsly apologies i cannot add a copy of my workbook as i am unable to update my computer) - so added images.
Essentially i have data in two columns (A and B) and would like to run macro to group these (and sub group) based on the values in column A - the workbook i have is forever changing were the sub service and service levels sit and runs for over 300 rows, so is very laborious to do manually.
I have spent time and managed to group the "Service" levels but am having great difficulty in adding the Sub Service grouping - see VBA below ( i am not precious about my code and am quite happy for you to pull this apart and re-write).
Sub group_rows()
Dim area As Range
Dim LR As Long
Dim rng As Range
LR = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox LR
Application.ScreenUpdating = False
'calls macro to ungroup rows first
ungroup_rows
On Error Resume Next
With Range("A1:A" & LR)
.AutoFilter Field:=1, Criteria1:="<>Service*"
Set rng = .Resize(.Rows.Count - 1, 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
.AutoFilter
End With
On Error GoTo 0
If Not rng Is Nothing Then
For Each area In rng.Areas
area.EntireRow.Group
Next area
End If
Application.ScreenUpdating = True
End Sub
The data runs in sequential order with all services running in order. Really hope the pictures help.
TOTAL DATA
Grouped by Sub Service
Grouped further to Service
Essentially i have data in two columns (A and B) and would like to run macro to group these (and sub group) based on the values in column A - the workbook i have is forever changing were the sub service and service levels sit and runs for over 300 rows, so is very laborious to do manually.
I have spent time and managed to group the "Service" levels but am having great difficulty in adding the Sub Service grouping - see VBA below ( i am not precious about my code and am quite happy for you to pull this apart and re-write).
Sub group_rows()
Dim area As Range
Dim LR As Long
Dim rng As Range
LR = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox LR
Application.ScreenUpdating = False
'calls macro to ungroup rows first
ungroup_rows
On Error Resume Next
With Range("A1:A" & LR)
.AutoFilter Field:=1, Criteria1:="<>Service*"
Set rng = .Resize(.Rows.Count - 1, 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
.AutoFilter
End With
On Error GoTo 0
If Not rng Is Nothing Then
For Each area In rng.Areas
area.EntireRow.Group
Next area
End If
Application.ScreenUpdating = True
End Sub
The data runs in sequential order with all services running in order. Really hope the pictures help.
TOTAL DATA
Grouped by Sub Service
Grouped further to Service
