VBA Macro to group rows that are colored

[shyy]

Hey guys,

I am in need of some assistance with VBA. I have in column A certain rows that have color. Is it possible to have a macro that will automatically group rows between the colors? In this example range A1:A19 would be grouped together. I have formula to the right of the colored cell to represent the partner's name. This way I can collapse/expand data easily. I have about 16,000 rows of data split between 20 partners. You can see why I want to collapse/expand information for certain partners.

Thanks in advance.

Excel 2010

	A
1	651113
2	Final K-1 Amended K-1 OMB No. 1545-0099 Schedule K-1
3	(Form 1065) Partner's Share of Current Year Income,
4	Deductions, Credits, and Other Items
5	A.ƒÊ�E Part III
6	Department of the Treasury For calendar year 2013, or tax
7	Internal Revenue Service
8	1
9	2
10	3
11	4
12	5
13	6a
14	6b
15	7
16	8
17	9a
18	9b
19	9c
20	Ordinary business income (loss)

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

 

[XLRATOR]

Hello,
Try this with an ActiveX button or in a standard Module:

Dim rng As Range
Range("A1:A19").Rows.Ungroup
For Each rng In Range("A1:A20").Cells
If rng.Interior.ColorIndex = xlNone Then
rng.Rows.Group
End If
Next

The code takes care of the changes that may occur.

 

[XLRATOR]

Sorry I've to correct myself thou,
This code works better:

Dim rng As Range
On Error Resume Next
For Each rng In Range("A1:A20").Cells
If rng.Interior.ColorIndex = xlNone Then
rng.Rows.Ungroup
rng.Rows.Group
End If
Next

 

[XLRATOR]

Or this:

Dim rng As Range
On Error Resume Next
For Each rng In Range("A1:A20").Cells
rng.Rows.Ungroup
If rng.Interior.ColorIndex = xlNone Then
rng.Rows.Group
End If
Next

 

[shyy]

Thank You, it works!

 

[bmohamed]

Or this:

Dim rng As Range
On Error Resume Next
For Each rng In Range("A1:A20").Cells
rng.Rows.Ungroup
If rng.Interior.ColorIndex = xlNone Then
rng.Rows.Group
End If
Next

How could these two lines be used to get the macro to run on worksheets with different number of total rows?

Dim rowCount As Integer
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

Thanks by the way for your original macro. Worked like a charm