VBA: Find a number of phrases in a sheet and highlight the row as long as one phrase is in it

xdriver

Board Regular
Joined
Mar 21, 2014
Messages
73
Office Version
  1. 365
Platform
  1. MacOS
I found this link and code that will do it if a single term is listed, but I want to list a handful of them. If the row contains any of the phrases, I would like to highlight it so I can later sort them to the top or bottom of the list OR if it's easier, copy them to another sheet in the document.

Selecting all cells with specific text

VBA Code:
Sub test()
Dim c As Range, FoundCells As Range
Dim firstaddress As String

Application.ScreenUpdating = False
With Sheets("Sheet1")
    'find first cell that contains "rec"
    Set c = .Cells.Find(What:="rec", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
    xlPart, MatchCase:=False)
    
    'if the search returns a cell
    If Not c Is Nothing Then
        'note the address of first cell found
        firstaddress = c.Address
        Do
            'FoundCells is the variable that will refer to all of the
            'cells that are returned in the search
            If FoundCells Is Nothing Then
                Set FoundCells = c
            Else
                Set FoundCells = Union(c, FoundCells)
            End If
            'find the next instance of "rec"
            Set c = .Cells.FindNext(c)
        Loop While Not c Is Nothing And firstaddress <> c.Address
                
        'after entire sheet searched, select all found cells
        FoundCells.Select
    Else
        'if no cells were found in search, display msg
        MsgBox "No cells found."
    End If
End With
Application.ScreenUpdating = True

End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
There is also this one, however it doesn't seem to be working for me and gives some errors as written.

USING FIND METHOD WITH A VARIABLE TO FIND A STRING

VBA Code:
Private Sub cmdFINDVERSE_Click()
Sheets("RESULT").UsedRange.ClearContents
Dim x As String
Dim c As Range
Dim rw As Long
Dim firstaddress As Variant
Dim rowno As Integer
x = Me.TextBox6.Value  --->Textbox6 can be any single word or string value, either between quotes or not
With Worksheets("Sheet2").Range("H1:H31103")
Set c = .Find(x, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
rw = 1
firstaddress = c.Address
Do
Worksheets("Sheet2").Select
Range(Cells(c.Row, 5), Cells(c.Row, 9)).Copy Destination:=Sheets("RESULT").Range("A" & rw)
rw = rw + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
rowno = Sheets("RESULT").Range("A1").End(xlDown).Row
Sheets("RESULT").Range("G1").Value = rowno
Sheets("RESULT").Range("H1").Value = x
Me.TextBox7.Value = Sheets("RESULT").Range("G1").Value
ListBox2.ListIndex = 0
SEARCHRESULTS.Show
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,908
Messages
6,122,187
Members
449,071
Latest member
cdnMech

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top