Find Multiple Text Colors of a Selected Range

[norts55]

I have a macro that was developed with the help of this forum. This macro searches my selected range, finds and selects all cells that are formatted with the text color RGB(1, 2, 2). I need to modify this macro to find multiple colors within my selection. I need to find text color RGB(1, 2, 2), text color RGB(13, 13, 13), text color RGB(38, 38, 38), I have a few more but if I can figure out how this works I should be able to add the others. Any help would be greatly appreciated.

Sub a_0_0_Change_Colors_to_Automatic() '' a_0_0_Change_Colors_to_Automatic Macro
'




'
    Dim rngFound As Range
    Dim rngAll As Range
    Dim strFirst As String
    Dim lColor As Long
    
    lColor = RGB(1, 2, 2)
    
    With Application.FindFormat
        .Clear
        .Font.Color = lColor        'Search for font color
        '.Interior.Color = lColor   'Search for background color
    End With
    
    With Selection
        Set rngFound = .Find("", .Cells(.Cells.Count), SearchFormat:=True)
        If Not rngFound Is Nothing Then
            Set rngAll = rngFound
            strFirst = rngFound.Address
            Do
                Set rngAll = Union(rngAll, rngFound)
                Set rngFound = .Find("", rngFound, SearchFormat:=True)
            Loop While rngFound.Address <> strFirst
            
            rngAll.Select
            
            Set rngAll = Nothing
            Set rngFound = Nothing
            strFirst = vbNullString
        Else
            MsgBox "No cells found with font color " & lColor & ".", , "No Matches"
            'MsgBox "No cells found with background color " & lColor & ".", , "No Matches"
        End If
    End With
    
    Application.FindFormat.Clear
End Sub

 

[Marcelo Branco]

Maybe something like this

Sub SelectCells()
    Dim rngFound As Range, rngAll As Range
    Dim strFirst As String, lColor As Variant, arrColors As Variant
        
    arrColors = Array(RGB(1, 2, 2), RGB(13, 13, 13), RGB(38, 38, 38))
    With Selection
        For Each lColor In arrColors
            With Application.FindFormat
                .Clear
                .Font.Color = lColor        'Search for font color
            End With
            On Error Resume Next
            Set rngFound = .Find("", .Cells(.Cells.Count), SearchFormat:=True)
            On Error GoTo 0
            If Not rngFound Is Nothing Then
                strFirst = rngFound.Address
                Do
                    If rngAll Is Nothing Then
                        Set rngAll = rngFound
                    Else
                        Set rngAll = Union(rngAll, rngFound)
                    End If
                    Set rngFound = .Find("", rngFound, SearchFormat:=True)
                Loop While rngFound.Address <> strFirst
            End If
        Next lColor
    End With
    
    If Not rngAll Is Nothing Then
        rngAll.Select
        Set rngAll = Nothing
        Set rngFound = Nothing
        strFirst = vbNullString
    Else
        MsgBox "No cells found with any font color "
    End If
    Application.FindFormat.Clear
End Sub

M.

 

[norts55]

That worked! Thanks!!!

 

[Marcelo Branco]

You are welcome. Thanks for the feedback.

M.