Find range by interior color
 

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

Find range by interior color
 

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

--
Regards,
Tom Ogilvy

"CG Rosén" wrote in message
...
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

Find range by interior color
 

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


"Tom Ogilvy" wrote in message
...
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

--
Regards,
Tom Ogilvy

"CG Rosén" wrote in message
...
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

Find range by interior color
 

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

--
Regards,
Tom Ogilvy



CG Rosén wrote in message
...
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


"Tom Ogilvy" wrote in message
...
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

--
Regards,
Tom Ogilvy

"CG Rosén" wrote in message
...
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