Find range by interior color

  • Thread starter Thread starter CG Rosén
  • Start date Start date
C

CG Rosén

Good Day,

How to approach the task to find ranges by its interior
color? Have intermitent, and unevenly, in the same Row, ranges with the same
interior color (=15). Is it possible to find the addresses of these ranges?
The ranges contain no values.

Brgds

CG Rosén
 
By looping

Dim rng as Range, cell as Range
for each cell in rows(9).Cells
if cell.interior.ColorIndex = 15
if rng is nothing then
set rng = cell
else
set rng = union(cell,rng)
end if
end if
Next
if not rng is nothing then
msgbox rng.Address
End if
 
Hi Tom,

Thanks for your help. Code works as expected. After some thinking and
"msgboxing"
I guess I get the code. But still not able to figure out how to find the
number of found
ranges and how to split them to separate variables. Grateful for more help.

Brgds

CG rosén
 
Sub Tester2()
Dim rngList() As Range
ReDim rngList(1 To 1)
Dim cell As Range
For Each cell In Rows(9).Cells
If cell.Interior.ColorIndex = 15 Then
Set rngList(UBound(rngList)) = cell
ReDim Preserve rngList(1 To UBound(rngList) + 1)
End If
Next
ReDim Preserve rngList(1 To UBound(rngList) - 1)
For i = LBound(rngList) To UBound(rngList)
msgbox i & ": " & rngList(i).AddressNext
End Sub

or if you don't want each separate cell, but want each area:

Sub Tester1()
Dim rng As Range, cell As Range
Dim rngList() As Range, i As Long
For Each cell In Rows(9).Cells
If cell.Interior.ColorIndex = 15 Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next
ReDim rngList(1 To rng.Areas.Count)
i = 0
For Each ar In rng.Areas
i = i + 1
Set rngList(i) = ar
msgbox i & ": " & rngList(i).Address
Next
End Sub
 
Back
Top