Load multiple Cells into an Array

[Nalani]

Sub Test2()
    Dim MYCELL As Object
    myColor = ActiveSheet.Range("A1").Interior.ColorIndex
    For Each MYCELL In ActiveSheet.UsedRange
        If (MYCELL.Interior.ColorIndex = myColor) Then myArray = MYCELL.Address
    Next MYCELL
End Sub

I am trying to load all Cell Addresses into MyArray that has the Interior.ColorIndex of A1 so I can use My Array later on in my code.

Stepping through the code, I see that myArray is reading each cell that, in this case has the Index no. 35.

I just don't know how to store all the cells together.

My UsedRange is A1:Q31 and I have two different Cell colors. About half of them will be the Index number I'm looking for.

Any help appreciated.

Thanks

 

[Krishnakumar]

Hi,

try

Sub kTest()
    Dim arrAddr()   As String
    Dim iColor      As Long
    Dim r           As Long
    Dim c           As Long
    Dim n           As Long
    
    iColor = ActiveSheet.Range("A1").Interior.Color
    
    With ActiveSheet.UsedRange
        For c = 1 To .Columns.Count
            For r = 2 To .Rows.Count
                If .Cells(r, c).Interior.Color = iColor Then
                    n = n + 1
                    ReDim Preserve arrAddr(1 To n)
                    arrAddr(n) = .Cells(r, c).Address(0, 0)
                End If
            Next
        Next
    End With
    
End Sub

HTH

 

[hiker95]

Nalani,


The following will load/build your dynamic array with the cell addresses.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Option Base 1
Sub Test2()
' hiker95, 04/13/2011
' http://www.mrexcel.com/forum/showthread.php?t=543446
Dim MYCELL As Object
Dim myArray() As Variant, a As Long
Dim myColor As Long
Application.ScreenUpdating = False
myColor = ActiveSheet.Range("A1").Interior.ColorIndex
a = 0
For Each MYCELL In ActiveSheet.UsedRange
  If MYCELL.Interior.ColorIndex = myColor Then
    a = a + 1
    ReDim Preserve myArray(1 To a)
    myArray(a) = MYCELL.Address
  End If
Next MYCELL
Application.ScreenUpdating = True
End Sub

 

[Nalani]

Thanks Kris & hiker,

Both code seem to load all the right cells. This was confirmed by looking in the Locals Window and hovering over the last (a) or depending on which code I used.

What I am trying to do next is to do a .Cells.Interior.ColorIndex = xlNone befor I print.

Then bring back the color to the cells that were loaded in the myArray or the arrAddr (again, on what code was used)

The closest I could get:

for testing - did not put in the xlNone for now

With Kris's code:

 ............
ReDim Preserve arrAddr(1 To n)
arrAddr(n) = .Cells(r, c).Address(0, 0)
End If 
Next
Next
End With
 
'// With / End With added 
 
With ActiveSheet.Range(arrAddr(n))
.Interior.ColorIndex = 6
End With
 
End Sub

This only colored the last element in the array Q31

With hiker's code:
I tried a different approach. But no good here either

.......
ReDim Preserve myArray(1 To a)
    myArray(a) = MYCELL.Address
  End If
Next MYCELL
Application.ScreenUpdating = True
 
For Each myArray In ActiveSheet
    .Interior.ColorIndex = 6
    Next

With this I get an Error: For Each control variable must be Variant or Object

Don't know what or where to go from here.

 

[hiker95]

Nalani,


Sample data before the macro:

Excel Workbook
	A	B	C	D	E
1
2
3
4
5
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E
1
2
3
4
5
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Option Base 1
Sub Test3()
' hiker95, 04/14/2011
' http://www.mrexcel.com/forum/showthread.php?t=543446
Dim MYCELL As Object
Dim myArray() As Variant, a As Long
Dim myColor As Long
Application.ScreenUpdating = False
myColor = ActiveSheet.Range("A1").Interior.ColorIndex
a = 0
For Each MYCELL In ActiveSheet.UsedRange
  If MYCELL.Interior.ColorIndex = myColor Then
    a = a + 1
    ReDim Preserve myArray(1 To a)
    myArray(a) = MYCELL.Address
  End If
Next MYCELL
For a = LBound(myArray) To UBound(myArray)
  ActiveSheet.Range(myArray(a)).Interior.ColorIndex = 6
Next a
Application.ScreenUpdating = True
End Sub

Then run the Test3 macro.

 

[Krishnakumar]

Hi,

Try

Sub kTest()
    
    Dim iColor      As Long
    Dim r           As Long
    Dim c           As Long
    Dim strAddr     As String
    
    iColor = ActiveSheet.Range("A1").Interior.Color
    
    With ActiveSheet.UsedRange
        For c = 1 To .Columns.Count
            For r = 2 To .Rows.Count
                If .Cells(r, c).Interior.Color = iColor Then
                    strAddr = strAddr & "," & .Cells(r, c).Address(0, 0)
                    If Len(strAddr) > 245 Then
                        .Range(Mid$(strAddr, 2)).Interior.Color = -4142
                        strAddr = ""
                    End If
                End If
            Next
        Next
        If Len(strAddr) > 1 Then
            .Range(Mid$(strAddr, 2)).Interior.Color = -4142
        End If
    End With

End Sub

HTH

 

[Nalani]

Sorry for the delay in getting back. I didn't whant to let the help go unnoticed:

Thanks hiker and kris,

Both codes work. I guess what was provided, shows there are more then one way to skin the cat.

Much appreciated.