Find and Highlight Cells Containing Specific Text

Question

I'm very new to VBA and I'm attempting to create a Sub that can find and highlight any cells in a worksheet that contain a particular text.

I've modeled my code after Pradeepta Pradhan's code in this link.

The sub I wrote works, but it is extremely slow. Any hints on how to speed this up or clean up my code?

Sub Find_Highlight_Comments3()
    Dim WS As Worksheet
    Dim Rng As Range
    Dim Match As Range
    Dim Comment As String

    Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")
    Set Rng = WS.UsedRange
    Comment = ("insoluble residue")
    Comment = ("non-gaussian")
    Comment = ("empty source well")
    Comment = ("source vial not received")
    Comment = ("foreign object")
    Comment = ("lacks nitrogen")
    Comment = ("lacks molecular")
    Comment = ("could not be assayed")
    Comment = ("not pass through Millipore filter")
    For Each Rng In Rng
    With Rng
        Set Match = WS.Cells.Find(What:=Comment, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not Match Is Nothing Then
                Match.Interior.Color = RGB(255, 255, 0)
            End If
    End With
    Next Rng
End Sub

Answer 1

Little modification to your code. As you mentioned about Pradeepta Pradhan's post, I have put additional lines to highlight the comment text with red font. You can refer to Siddharth's post below the same post.

I have put all those comments in comments array. If you want to add two more comments then first change the redim statement to 10. Note that array starts from index 0. Also, just find is not enough if you want to find all subsequent occurances of the same comment. So, added findnext as well.

Sub Find_Highlight_Comments3()
Dim WS As Worksheet
Dim Match As Range
Dim Comment() As String

Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")

ReDim Comment(8)
    Comment(0) = "insoluble residue"
    Comment(1) = "non-gaussian"
    Comment(2) = "empty source well"
    Comment(3) = "source vial not received"
    Comment(4) = "foreign object"
    Comment(5) = "lacks nitrogen"
    Comment(6) = "lacks molecular"
    Comment(7) = "could not be assayed"
    Comment(8) = "not pass through Millipore filter"

For i = LBound(Comment) To UBound(Comment)
Set Match = WS.Cells.Find(What:=Comment(i), LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If Not Match Is Nothing Then
    FirstAddress = Match.Address
        Do
        sPos = InStr(1, Match.Value, Comment(i))
        sLen = Len(Comment(i))
        Match.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
        Match.Interior.Color = RGB(255, 255, 0)
        Set Match = WS.Cells.FindNext(Match)
        Loop While Not Match Is Nothing And Match.Address <> FirstAddress
    End If
Next
End Sub