VBA to Group Rows Based on Same Values

[austinandreikurt]

Hi,
I think this is easy but I just can't figure out the logic I need to group rows based on rows in a column with same values. Technically, its like grouping main group and subgroup based on their values. I created a formula-based column that indicate numbers based on cell values e.g Group all 1, group all 2 and so on. My values are simplified through integers and it will always be in ascending order like if Cell A1 to A5 is 1 and Cell A6 to A15 is 2, it is impossible to have another 1 in other cells in Column A. Below are the conditions:
1. Direction of Grouping is to Summarize Rows Above Detail
2. The first instance of the number will be the Main Group and the rest are subgroups
3. Grouping will only happen if the values have 2 or more. You will see in the minisheet the #7 in Cell A43 not grouped since there is no similar values
4. Grouping should only for cells with numbers, meaning 0 and blanks should not be grouped.
Thank you in advance!

Book1
	A
1
2
3
4
5
6
7	0
8	0
9	0
10	0
11	1
12	2
13	2
14	2
15	3
16	3
17	3
18	3
19	3
20	3
21	3
22	3
23	3
24	3
25	4
26	4
27	4
28	4
29	5
30	5
31	5
32	5
33	5
34	5
35	5
36	5
37	5
38	6
39	6
40	6
41	6
42	6
43	7
44	8
45	8
46	8
47	8
48	8
49	8
50	8
51	8
52	8
53	8
54	9
55	9
56	9
57	9
58	9
59	9
60	9
61	9
62	9
63	9
64	9
Sheet1

 

[bebo021999]

With column A is in increasing order

Option Explicit
Sub test()
Dim lr&, k&, i&, cell As Range, StartC As String, endC As String, arr(1 To 10000, 1 To 1)
lr = Cells(Rows.Count, "A").End(xlUp).Row
With WorksheetFunction
    For Each cell In Range("A1:A" & lr)
        If Not IsEmpty(cell) And cell.Value <> 0 And .CountIf(Range("A1:A" & lr), cell) > 1 Then
            If .CountIf(Range("A1", cell.Offset(-1, 0)), cell) = 0 Then
                StartC = cell.Address(0, 0)
            ElseIf .CountIf(Range(cell.Offset(1, 0), Cells(lr, 1)), cell) = 1 Then
                endC = cell.Address(0, 0)
            End If
        End If
        If endC <> "" Then
            k = k + 1
            arr(k, 1) = StartC & ":" & endC
            StartC = "": endC = ""
        End If
    Next
    For i = 1 To k
        Range(arr(i, 1)).Rows.Group
    Next
End With
End Sub

 

[austinandreikurt]

Hi @bebo021999 Thank you for taking your time on this. I have tried the codes but it gives me an error on "Range(arr(i, 1)).Rows.Group" though it already made the groupings until the last row. For the grouping, this one is "Summarize Rows Below the Detail". I will need it "above" details since the Main Group is at the top cells and Subgroups below it. I tried to untick first the "Summarize Rows Below the Detail" in the Outline settings first before running the codes but the grouping is messed up.

 

[austinandreikurt]

Hi again, just to emphasize condition #4, there can be blank cells in between Column A and it should not be grouped (They are actually TOTALS or special subtotal rows which should always be visible and not grouped. Only the rows with integer numbers would be grouped

Columns B and so on has data, thus I cannot used a helper column just in case. Thanks in advance!

 

[austinandreikurt]

Any help on this? Thanks in advance!

 

[bebo021999]

How you can get that group in worksheet built-in tools?
I tried to highlight group of 3, then Data/Group click

It help a lot if you record into macro how to create that kind of group then post the macro here.

 

[austinandreikurt]

How you can get that group in worksheet built-in tools?
I tried to highlight group of 3, then Data/Group click

View attachment 69247
It help a lot if you record into macro how to create that kind of group then post the macro here.

Hi @bebo021999 this is the recorded code for that.

    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight
    End With

Thus after setting this up, on the above sample Group of 3, the macro code should select the 2nd to 9th "3" for the groupings to be on the 1st "3".

 

[bebo021999]

How you can get that group with worksheet built-in tools?

 

[austinandreikurt]

Hi @bebo021999 sorry, but what do you mean built-in tools? I'm using office 365 now and its on DATA --- Outline Group then the little arrow settings there. Say I have this simple data for now, this will be how it will be done manually which I recorded.

Book1
	A
1	1
2	1
3	1
4	1
5	1
6	1
7	2
8	2
9	2
10
11
12	3
13	4
14	4
15	4
16	4
17	4
18	4
19
20
21
Sheet2

Sub test()

    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight
    End With
    Range("A2:A6").Select
    Selection.Rows.Group
    Range("A8:A9").Select
    Selection.Rows.Group
    Range("A14:A18").Select
    Selection.Rows.Group
   
End Sub

As you can see on the manual recorded codes, the blank rows in Column A as well as the single integer with no duplicates will not be grouped. Only those with duplicates. And these duplicates would always be consecutive order and will not be scattered.

 

[austinandreikurt]

Hmm, if there is a constraint of having the grouping because of excel version, we can just make it into coloring then I will modify the codes to change it into grouping. I have attached images on how it should look like. Basically, I need a macro that would check all rows in Column A up to the last row with data and color it based on criteria:
1. If row values is either 0 or blank, then just ignore it;
2. If row value has no duplicate on the next cells, then just ignore it;
3. If row value has duplicate on the next cell or cells (say we are looking into A5, then it will be A6 and so on), then DO NOT color the cell but color the next cells below it that are duplicate to it.
But the macro should not color it individually. I mean it should select the cells first by batch then color it for me to modify the color scheme into grouping.