Trying to group rows with same values in VBA

Eric Penfold

Active Member
Joined
Nov 19, 2021
Messages
417
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
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

VBA Code:
LBRow = CRow

VBA Code:
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
 
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
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
OK, I don't like trying to reverse other's complex code, and prefer to write my own, so try this:
VBA Code:
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
 
Upvote 0
Solution
Thanks so much for your help, time and explanation on the code. Have a good weekend
 
Upvote 0
You are welcome.
I am glad it works for you!
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top