Trying to group rows with same values in VBA

[Eric Penfold]

I`ve created this code but when i run it nothing happens?
I think these 2 Dims should match to run the code is this right

LBRow = CRow

Sub Group_PartNos()


    Dim ws As Worksheet
    Dim Rng As Range
    Dim ERow, CRow, FBRow, LBRow As Long
    Dim CRValue, NRValue As String
    
    Application.ScreenUpdating = False
    
    Set ws = ActiveSheet
    ERow = Range("C2").End(xlDown).Row
    Set Rng = ws.Range("C2:C" & ERow)
    
    FBRow = 0
    LBRow = 0
    
    For CRow = 2 To ERow
        CRValue = Cells(CRow, Rng.Column).Value
        NRValue = Cells(CRow + 1, Rng.Column).Value
        
        If Not (IsEmpty(CRValue) Or CRValue = "") Then
          If Not (IsEmpty(NRValue) Or NRValue = "") Then
           FBRow = CRow + 1
           End If
        ElseIf (IsEmpty(CRValue) Or CRValue = "") Then
           If Not (IsEmpty(NRValue) Or NRValue = "") Then
            If FBRow = CRow <> 0 Then
             LBRow = CRow
            End If
          End If
        End If
        
        If FBRow <> 0 And LBRow <> 0 Then

        If Not ws.Rows(CurrentRow).OutlineLevel > 1 Then
          ws.Range(Cells(FBRow, Rng.Column), Cells(LBRow, Rng.Column)).EntireRow.Select
          Selection.Group
          End If
          FBRow = 0: LBRow = 0
        End If
      Next
        
        Application.ScreenUpdating = True
          
End Sub

 

[Eric Penfold]

Or do you want all the data sorted first by column C so ALL of the Order Numbers are together (and all 3 would be grouped in this scenario)? Yes this is what I need

 

[Joe4]

OK, I don't like trying to reverse other's complex code, and prefer to write my own, so try this:

Sub MyGroupMacro()

    Dim lr As Long
    Dim r As Long
    Dim ct As Long
    Dim fr As Long
    
'   Find last row in column C with data
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
'   Sort data by column C
    Range("C1:C" & lr).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom
    
    Application.ScreenUpdating = False
    
'   Initialize values
    fr = 2
    ct = 1
'   Loop through all rows starting with row 3
    For r = 3 To lr
'       Check to see if value in cell C matches row above
        If Cells(r, "C").Value = Cells(r - 1, "C") Then
'           Increment count
            ct = ct + 1
        End If
'       See if it does NOT match next row
        If Cells(r, "C").Value <> Cells(r + 1, "C") Then
'           Check count
            If ct > 1 Then
'               Group rows
                Rows(fr & ":" & r).Group
            End If
'           Reset count and start row
            ct = 1
            fr = r + 1
        End If
    Next r
    
    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
    
End Sub

 

[Eric Penfold]

Thanks so much for your help, time and explanation on the code. Have a good weekend

 

[Joe4]

You are welcome.
I am glad it works for you!