Selecting cells by color in VBA

paydog23

New Member
Joined
Jul 12, 2017
Messages
13
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.

Select Cells By Color.jpg
 

Chris Macro

Well-known Member
Joined
Nov 2, 2011
Messages
1,341
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

MrExcel MVP
Joined
May 26, 2009
Messages
16,645
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.
Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
7,811
Office Version
2007
Platform
Windows
Continuing with your idea

VBA Code:
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
 

Forum statistics

Threads
1,077,994
Messages
5,337,611
Members
399,156
Latest member
RaudMees

Some videos you may like

This Week's Hot Topics

Top