I want to group rows in the below mock table based on the cell values in the second column.

Initial excel table:

Final desired excel table

Order can be anything.

Viewed a lot of related questions and answers but they were slightly confusing.

I have tried out various answers but they did not quite work as expected. I want to start the solution to this problem from scratch and fresh point of view.

CodePudding user response：

This is the simplest way I can imagine:
Create a helper column, containing the following formula:

=MATCH(B2,B$2:B$6,0)

... and just order, using that column.

This is what it looks like when you start:

This is what it looks like after having ordered using the new column:

(Obviously, the values have changed, but this does not modify the behaviour of the situation.)

CodePudding user response：

Group Data

Sub GroupData()
    
    ' Define constants.
    
    Const GroupColumn As Long = 2
    
    ' Reference the range.
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range, rCount As Long, cCount As Long
    
    With ws.Range("A1").CurrentRegion
        rCount = .Rows.Count - 1 ' exclude headers
        If rCount < 2 Then
            MsgBox "Nothing to group.", vbExclamation
            Exit Sub
        End If
        cCount = .Columns.Count
        If cCount < GroupColumn Then
            MsgBox "Need more columns.", vbExclamation
            Exit Sub
        End If
        Set rg = .Resize(rCount).Offset(1)
    End With
    
    ' Write the values from the range to an array, the Source array.
    
    Dim sData() As Variant: sData = rg.Value
    
    ' Write each unique value from the Group column of the Source array
    ' to the 'key' of a dictionary, and the associated row number(s)
    ' to the collection held by each associated 'item'.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long, rString As String
    
    For r = 1 To rCount
        rString = CStr(sData(r, 2))
        If Not dict.Exists(rString) Then Set dict(rString) = New Collection
        dict(rString).Add r
    Next r
    
    ' Using the information in the dictionary, write the values from
    ' the Source array grouped to the (same-sized) Destination array.
    
    Dim dData() As Variant: ReDim dData(1 To rCount, 1 To cCount)
    
    Dim rKey As Variant, rItem As Variant, c As Long
    
    r = 0
    
    For Each rKey In dict.Keys
        For Each rItem In dict(rKey)
            r = r   1
            For c = 1 To cCount
                dData(r, c) = sData(rItem, c)
            Next c
        Next rItem
    Next rKey
    
    ' Write the values from the Destination array to the range.
    
    rg.Value = dData
        
End Sub