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

user_15586050 0
Viewed 65

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
format vba excel
1 Answers

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)
user_75997980
Related