Select by Interior Color

[Ritt]

In VBA how can I select a range of cells that have the same Interior color that is in like cell A1 in a range of cells B3:I18. Thanks for all your help.

 

[meldoc]

Hello

Try this, on a COPY of your data.

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><SPAN style="color:#00007F">Sub</SPAN> test()<br>**<SPAN style="color:#00007F">Dim</SPAN> colour <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, Frng <SPAN style="color:#00007F">As</SPAN> Range, Srng <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, cel <SPAN style="color:#00007F">As</SPAN> Range<br>**colour = Range("A1").Interior.Color<SPAN style="color:#00007F">In</SPAN>dex<br>**<SPAN style="color:#00007F">Set</SPAN> Frng = Range("B3:I18")<br>**Srng = ""<br>**<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cel In Frng<br>****<SPAN style="color:#00007F">If</SPAN> cel.Interior.ColorIndex = colour <SPAN style="color:#00007F">Then</SPAN> Srng = Srng + cel.Address & ","<br>**<SPAN style="color:#00007F">Next</SPAN> cel<br>****<SPAN style="color:#00007F">If</SPAN> Srng <> "" <SPAN style="color:#00007F">Then</SPAN><br>******Srng = Left(Srng, Len(Srng) - 1)<br>******Range(Srng).Select<br>****<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
Adapted from this link.

http://forums.techguy.org/business-applications/505523-excel-macro-selecting-multiple-cells.html

 

[Sahak]

Option Explicit
Sub SameColorSelection()
    Dim MyClr As Long
    Dim MyClrs As Range
    Dim MyCells As Range
    MyClr = Range("A1").Interior.Color
    For Each MyCells In Range("B3:I18")
        If MyCells.Interior.Color = MyClr Then
            If MyClrs Is Nothing Then
                Set MyClrs = MyCells
            Else
                Set MyClrs = Union(MyClrs, MyCells)
            End If
        End If
    Next
    If MyClrs Is Nothing Then
        MsgBox "No Color Match"
    Else
        MyClrs.Select
    End If
End Sub

 

[Ritt]

Thanks Guys you have been a big help. Hope your day is going well.