Macro to highlight rows if a cell contains any of a group of words

[theora]

Hi,

I need a macro to highlight rows where the cell in column N contains any one of a list of words. I tried using Advance Filter but I couldn't get it to work. Column N contains notes so I want to find specific text strings in each cell.

So for example cell N3 contains "Please modify the Network User ID for the following Customer". I want to highlight the whole row if it contains any of the words customer, workstation, windows, account etc.

I actually need to delete those rows but my spreadsheets contain anything up to 10,000 rows and I need to search for about 20 different text strings so I figured it would be faster to highlight all those rows and then filter on the highlight and delete them all at once instead of trying to use the one macro to both find and delete the rows.

Hope I've explained it well enough.

Leigh

 

[Akuini]

@theora Welcome to the Forum

Try this:
1. Put the search list (the about 20 different text strings) in sheet2 col A
2. In the sheet with data you need a helper column e.g col Z.
3. The sheet with data must be the active sheet when you run the macro.
4. If you don't want to delete the intended rows just remove these lines:

        On Error Resume Next
           .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
        On Error GoTo 0
        .ClearContents

the cells with "TRUE" in col Z are the intended cells.

Sub a1158554a()
'https://www.mrexcel.com/board/threads/macro-to-highlight-rows-if-a-cell-contains-any-of-a-group-of-words.1158554/
Dim i As Long, n As Long
Dim va, vb

With Sheets("Sheet2")
 vb = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

va = Range("N1", Cells(Rows.Count, "N").End(xlUp))

For i = 1 To UBound(va, 1)
    For Each x In vb
        If InStr(1, va(i, 1), x, vbTextCompare) Then va(i, 1) = True: Exit For
    Next
Next
       'col Z as helper column
       With Range("Z1").Resize(UBound(va, 1), 1)
        .Value = va
        On Error Resume Next
           .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
        On Error GoTo 0
        .ClearContents
       End With
 
End Sub

 

[Zot]

Here is another alternative.

I don't know how many keyword. I just put 3 keywords only here. If you want to just highlight remark the Delete line

Sub HighlightKeyword()

Dim eRow&
Dim strKeyword$
Dim Element As Variant, ArryKeyword$()
Dim cell As Range, rngN As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")
eRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
Set rngN = ws.Range("N1", "N" & eRow)

strKeyword = "Customer,Workstation,Windows"
ArryKeyword = Split(strKeyword, ",")

On Error Resume Next
For Each Element In ArryKeyword
    Set cell = rngN.Find(Element, Lookat:=xlPart)
    If Not cell Is Nothing Then
'        cell.Interior.ColorIndex = 3
        cell.EntireRow.Delete
    End If
    Err.Clear
Next
On Error GoTo 0

End Sub

 

[theora]

Thanks for the quick responses, you've saved me a lot of time as I have to do these spreadsheets daily and it was taking a couple of hours, now takes a few minutes.

Really appreciate your help.

 

[Zot]

Thanks for the quick responses, you've saved me a lot of time as I have to do these spreadsheets daily and it was taking a couple of hours, now takes a few minutes.

Really appreciate your help.

Glad it helps.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.