CODEWITHSUNDEEP
excelvba
Ras
Ras

Reputation: 67

Grouping rows in Excel with similar values

I have a table with the first column containing some numbers and I want to loop through and group the rows of my table based on the values in this first column so that they can be collapsible. So similar to what shift+alt+right does. As an example I would want to convert a table with rows like this

1

1

2

3

3

3

Into a table like this with each grouping being expandable and on the same level.

1

2

3

I have been trying to change the macro I found from https://superuser.com/questions/867796/excel-macro-to-group-rows-based-on-a-cell-value. My current macro is... 

Dim LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Dim StartRow As Integer
StartRow = 8

groupBegin = StartRow 'For the first group
For i = StartRow To LastRow

    If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
        groupEnd = i - 1
        Rows(groupBegin & ":" & groupEnd).Select
        Selection.Rows.Group
        groupBegin = i + 1 'adding one to keep the group's first row
    End If

Next i

Rows(groupBegin & ":" & LastRow).Select
Selection.Rows.Group

ActiveSheet.Outline.ShowLevels RowLevels:=1 'Minimize all the groups

This however groups all the rows together. Any guidance on how to achieve this would be appreciated.

Upvotes: 0

Views: 3647

Answers (2)

Khalid Saifaldeen
Khalid Saifaldeen

Reputation: 157

Below is the code to do the task. Note that the code assumes the numbers are sorted and there is no blank space between the rows.

Sub Group_Similar_Rows()

Dim i As Long
Dim lRef_Number As Long
Dim lNumber As Long
Dim lCount As Long
Dim lStarting_Row As Long
Dim lDate_Column As Long
Dim wks As Worksheet

lStarting_Row = 1 ' Change this to the starting row of your data
lDate_Column = 1 ' Chnage this to the column index of your data

Set wks = ThisWorkbook.ActiveSheet

lRef_Number = wks.Cells(lStarting_Row, lDate_Column)

lCount = -1
For i = 0 To 100000 ' if your data entry is more than 100,000 increase this the value
    
    If wks.Cells(lStarting_Row + i, lDate_Column) = "" And lCount <= 0 Then
        Exit For
    End If
    
    lCount = 1 + lCount
    lNumber = wks.Cells(lStarting_Row + i, lDate_Column)
    
    If lNumber <> lRef_Number Then
    
        lRef_Number = wks.Cells(lStarting_Row + i, lDate_Column)
        
        If i > 1 Then
            lCount = lCount - 1
        End If
        
        If lCount > 0 Then
            lCount = 1 + lCount
            wks.Rows(lStarting_Row + i - lCount & ":" & lStarting_Row + i - 2).Group
        
        End If
        
        lCount = 0
        
    End If

Next i

End Sub

Below is picture showing what the result of running the code:

result of running the code

Upvotes: 2

Cyril
Cyril

Reputation: 6829

Example of my comment

dim i as long, j as long
for i = 10 to 1 Step -1
    if not cells(i,1).value = cells(i-1,1).value then rows(i).insert
next i
for j = 1 to 10
    if cells(j,1).value <> "" then rows(j).group
next j

untested, but should give the appropriate example.

Upvotes: 1

Related Questions