Use `Application.FindFormat` to find all the other different format (Color)? - excel

Question

I am using the below code to select the colored cells (Yellow) on usedrange.
In the same sheet I have other cells filled with another different colors.
I am asking, is it possible to use Application.FindFormat to find all the other different format (Color)?
I tried to use :
Application.FindFormat.Interior.Color <> vbYellow
But I got syntax error. In advance, grateful for all your help.
Sub Answer()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim crg As Range
Set crg = ws.UsedRange
Application.FindFormat.Interior.Color = vbYellow
Dim rg As Range, c As Variant, FirstAddress As Variant
Set c = crg.Find(What:=vbNullString, SearchFormat:=True)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If rg Is Nothing Then
Set rg = c
Else
Set rg = Union(rg, c)
End If
Set c = crg.Find(What:=vbNullString, after:=c, SearchFormat:=True)
Loop While c.Address <> FirstAddress
rg.Select
Else
MsgBox "no cell with yellow color found"
End If
End Sub

Answer 1

The Application.FindFormat in Excel/VBA can do exactly the same as the Find-Dialog in Excel. As you can see, there is no "not equal" search in Excel for formatting, so there is no such search in VBA.
To get a list of colors and it's usage, you will have to loop over all cells. The following code builds a dictionary of colors and it's usage and dumps the result to the immediate window. Call it for example with ListAllColors ws.UsedRange
Sub ListAllColors(r As Range)
Dim colorList As Object
Set colorList = CreateObject("Scripting.Dictionary")
Dim cell As Range
For Each cell In r
Dim color
If cell.Interior.ColorIndex <> xlNone Then
color = cell.Interior.color
If colorList.exists(color) Then
' Color already in List, add cell to Range
Dim colorRange As Range
Set colorRange = colorList(color)
Set colorList(color) = Union(colorRange, cell)
Else
' New color, add entry to Dict
colorList.Add color, ""
' Ensure that the content is set to the cell itself, not the value.
Set colorList(color) = cell
End If
End If
Next
' Dump the result
For Each color In colorList.keys
Dim red As Long, green As Long, blue As Long
Call getRGB(CLng(color), red, green, blue)
Debug.Print color, "R:" & red, "G:" & green, "B:" & blue, colorList(color).Address
Next
End Sub
' Split color into it's red, green and blue parts
Public Sub getRGB(color As Long, ByRef red As Long, ByRef green As Long, ByRef blue As Long)
red = color And vbRed
green = (color And vbGreen) \ &H100
blue = (color And vbBlue) \ &H10000
End Sub
Update
To get a range of all colored cells, you can simplify the code, you will still have to loop over all cells, but can immediately build the union. Have a look to the following function. I added an optional parameter so you can ignore all cells with a certain color (eg vbYellow).
Function GetColoredCells(r As Range, Optional IgnoreColor As Long = -1) As Range
Dim cell As Range
For Each cell In r
Dim color
If cell.Interior.ColorIndex <> xlNone And cell.Interior.color <> IgnoreColor Then
If GetColoredCells Is Nothing Then
Set GetColoredCells = cell
Else
Set GetColoredCells = Union(GetColoredCells, cell)
End If
End If
Next
End Function
To omit the first line, call the function for example like that:
Set rg = GetColoredCells(ws.UsedRange.Offset(1, 0), vbYellow)