Range Grouping problem

[pingme89]

I have a spreadsheet with cell information on a worksheet.

For instance in Column A, I have have Cell name ("A1", "A2","A3" , "B21" ... etc)
In another column I have interior cell colors for each cell listed in Column A.

Instead of using:
ActiveSheet.Range("A1").interior.color = rgb(255,255,255)
ActiveSheet.Range("A2").interior.color = rgb(255,255,255)
ActiveSheet.Range("A3").interior.color = rgb(255,255,255)
ActiveSheet.Range("A4").interior.color = rgb(255,255,255)
ActiveSheet.Range("B2").interior.color = rgb(255,20,50)
ActiveSheet.Range("C2").interior.color = rgb(255,20,50)
ActiveSheet.Range("D2").interior.color = rgb(255,20,50)
ActiveSheet.Range("B3").interior.color = rgb(255,20,50)
ActiveSheet.Range("C3").interior.color = rgb(255,20,50)
ActiveSheet.Range("D3").interior.color = rgb(255,20,50)

I can't figure out how to sort the Interior colors in groupings. In my spreadsheet the Interior colors are listed in Column I with values like RGB(255,20,50).
I want to group cells in a string like "A1:A4" as in the above example all have the same interior color. And string grouped as "B2:D3".

 

[Akuini]

GroupedRNG.Add ThisWorkbook.Worksheets("Info").Range("AA" & i).Value

What are the value in those cells? Cell address?

 

[pingme89]

Yes. Like the list below

C68

D68

E68

F68

G68

H68

I68

J68

C69

D69

E69

F69

G69

H69

I69

J69

C70

D70

E70

F70

G70

H70

I70

J70

C71

D71

E71

F71

G71

H71

I71

J71

C72

D72

E72

F72

G72

H72

I72

J72

C73

D73

E73

F73

G73

H73

I73

J73

 

[Akuini]

You don't need collection, just use range object.
Try:

Sub try()

Dim Rng As Range

'Set rng = ThisWorkbook.Worksheets("Info").Range("A1", Cells(Rows.Count, "A").End(xlUp))
Set Rng = Range("A1", Cells(Rows.Count, "A").End(xlUp)) 'get range from A1 to last row with data
Debug.Print GroupCollectionRNG(Rng)

End Sub

Private Function GroupCollectionRNG(ByRef c As Range) As String
Dim r As Range, x As Range
For Each x In c
'Debug.Print x.Address
      If r Is Nothing Then
        Set r = Range(x.Value)
      Else
        Set r = Union(r, Range(x.Value))
      End If
Next
GroupCollectionRNG = r.Address(0, 0)
End Function

 

[pingme89]

You don't need collection, just use range object.
Try:

Sub try()

Dim Rng As Range

'Set rng = ThisWorkbook.Worksheets("Info").Range("A1", Cells(Rows.Count, "A").End(xlUp))
Set Rng = Range("A1", Cells(Rows.Count, "A").End(xlUp)) 'get range from A1 to last row with data
Debug.Print GroupCollectionRNG(Rng)

End Sub

Private Function GroupCollectionRNG(ByRef c As Range) As String
Dim r As Range, x As Range
For Each x In c
'Debug.Print x.Address
      If r Is Nothing Then
        Set r = Range(x.Value)
      Else
        Set r = Union(r, Range(x.Value))
      End If
Next
GroupCollectionRNG = r.Address(0, 0)
End Function

I modified your code to take the input as a collection and it works well. Thanks.

Private Function GroupCollectionRNG(RangeCollection As VBA.Collection) As String
Dim r As Range
Dim i  As Long
CollectionCount = RangeCollection.Count

For i = 1 To CollectionCount
    EleRNG = RangeCollection(i)
    If r Is Nothing Then
        
        Set r = Range(EleRNG)
    Else
        Set r = Union(r, Range(EleRNG))
    End If
Next i
GroupCollectionRNG = r.Address(0, 0)
End Function

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.