Selecting cells by color in VBA

[paydog23]

I would like to select all cells in the dataset A2:F156 where the color index is 19 (light orange) or 40 (dark orange). I have uploaded a picture of my dataset below.

I have compiled the following code:

Sub SelectByColor
Dim cell as range, rng as range

Set rng = range("A2:F841")
For each cell in rng

If cell.Interior.ColorIndex = 19 or cell.Interior.ColorIndex = 40 Then​

cell.select​

End If​

Next cell
End Sub

Of course, it doesn't work and it just selects the last cell in the dataset, F156.

 

[Chris Macro]

Try this:

Sub SelectByColor()
Dim cell As Range
Dim rng As Range
Dim FoundRange As Range

Set rng = Range("A2:F841")

For Each cell In rng.Cells
If cell.Interior.ColorIndex = 19 Or cell.Interior.ColorIndex = 40 Then
If FoundRange Is Nothing Then
Set FoundRange = cell
Else
Set FoundRange = Union(FoundRange, cell)
End If
End If
Next cell

If Not FoundRange Is Nothing Then FoundRange.Select

End Sub

 

[JoeMo]

My colorindex 19 looks more like light yellow than light orange. In any case, this may be faster if there are a large number of cells in the target range.

Sub SelectByColor()
Dim R As Range, F1 As Range, F2 As Range, fAdr As String, F19 As Range, F40 As Range
Set R = Range("A2:F841")
With Application
   .FindFormat.Clear
   .FindFormat.Interior.ColorIndex = 19
   Set F1 = R.Find("", searchformat:=True)
   If Not F1 Is Nothing Then
       fAdr = F1.Address
       Set F19 = F1
       Do
           Set F1 = R.Find("", F1, searchformat:=True)
           If F1 Is Nothing Then Exit Do
           If F1.Address = fAdr Then Exit Do
           Set F19 = Union(F1, F19)
       Loop
   End If
   .FindFormat.Clear
   .FindFormat.Interior.ColorIndex = 40
   Set F2 = R.Find("", searchformat:=True)
   If Not F2 Is Nothing Then
       fAdr = F2.Address
       Set F40 = F2
       Do
           Set F2 = R.Find("", F2, searchformat:=True)
           If F2 Is Nothing Then Exit Do
           If F2.Address = fAdr Then Exit Do
           Set F40 = Union(F2, F40)
       Loop
   End If
   If Not F1 Is Nothing And Not F2 Is Nothing Then
       Union(F19, F40).Select
   End If
   .FindFormat.Clear
End With
End Sub

 

[DanteAmor]

Continuing with your idea

Sub SelectByColor_2()
  Dim cell As Range, u As Boolean
  For Each cell In Range("A2:F841")
    If cell.Interior.ColorIndex = 19 Or cell.Interior.ColorIndex = 40 Then
      If u = False Then cell.Select:  u = True
      Range(Selection.Address & "," & cell.Address).Select
    End If
  Next
End Sub