CODEWITHSUNDEEP
excelvba
Michael McKeehan
Michael McKeehan

Reputation: 57

Macro to find specific words in a list of string expressions

What I am attempting to do is reference one column to find a keyword in another column. For example:

Simplified Example

What I will need to search is thousands of cells in column C to hundreds in Column A. When a string is found in A from C, I would like it to Highlight.

In this case after the Macro is ran the only cells that would be highlighted would be "Bird Cat" and "The Snake". What I have got so far is the following:

Sub Test()

Columns("A:A").Select
        Selection.Find(What:="Bird", After:=ActiveCell, LookIn:=x1Formulas2, _
        LookAt:=x1Part, SearchOrder:=x1ByRows, SearchDirection:=x1Next, _
        MatchCase:=False, SearchFormulas:=False).Activate
    Selection.Style = "Good"
    Cells.FindNext(After:=ActiveCell).Activate

    
End Sub

At one point I did have a Do Until IsEmpty(ActiveCell)...Loop in the code but I was thinking that would not work.

I am still new to coding in VBA so any input in general would be welcomed.

Upvotes: 0

Views: 868

Answers (1)

Variatus
Variatus

Reputation: 14383

This code employs Find and FindNext to look for a single word and mark all cells where it was found.

Sub MarkMatches(ByVal Crit As String)
    ' 085

    Dim Rng         As Range                ' range to search
    Dim Fnd         As Range                ' cell where match was found
    Dim FirstFnd    As Long                 ' row where a match was first found
    Dim Arr         As Variant              ' Rng.Value (for execution speed)
    
    With Worksheets("Sheet2")               ' change to suit
        ' search in column A, starting from row 1
        Set Rng = .Range(.Cells(1, "A"), _
                         .Cells(.Rows.Count, "A").End(xlUp))
    End With
    
    With Rng
        Arr = .Value
        .Interior.Pattern = xlNone          ' clear existing colouring
        Set Fnd = .Find(Crit, .Cells(.Cells.Count), _
                        xlValues, xlPart, MatchCase:=False)
        If Not Fnd Is Nothing Then
            FirstFnd = Fnd.Row
            Do
                ' "1" refers to column A here:-
                Arr(Fnd.Row, 1) = " " & Arr(Fnd.Row, 1) & " "
                ' exclude partial matches, like "catalog" matching "cat"
                If InStr(1, Arr(Fnd.Row, 1), " " & Crit & " ", vbTextCompare) Then
                    Fnd.Interior.Color = vbYellow       ' mark found match
                End If
                Set Fnd = .FindNext(Fnd)
                If Fnd Is Nothing Then Exit Do
            Loop While Fnd.Row > FirstFnd
        End If
    End With
End Sub

You can call the above sub with a procedure like the one given below.

Sub Macro1()
    MarkMatches "bird"
End Sub

Instead of specifying the word you might specify a cell reference, like 'MarkMatches(Cells(2, "A").Value'. If you wish to search for a list of words you could place this call in a loop but you would first need to resolve how to differentiate between words marked because they match one criterion or another.

The procedure MarkMatches contains the line Rng.Interior.Pattern = xlNone which removes all previous highlights. The action of this line could be moved to the calling procedure but your present question doesn't say enough about your intentions to implement a better strategy.

Upvotes: 1

Related Questions