VBA Find and Select multiple terms

[juk77]

Hi,

Basically got code elsewhere that does a Find All + Selects for a specific term:

Sub Find()Dim c As Range, FoundCells As Range
Dim firstaddress As String


Application.ScreenUpdating = False
With Sheets("Sheet1")
    'find first cell that contains "term"
    Set c = .Cells.Find(What:="term", 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

This works fine but I'm trying to extend it to Find and Select Multiple terms, not having any luck.

Latest example of my attempts:

Sub FindIrelandBelfast()'
' FindIrelandBelfast Macro
'


'
Dim c As Range, FoundCells As Range
Dim firstaddress As String
Dim c2 As Range, FoundCells2 As Range
Dim firstaddress2 As String


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

Just selects a single cell from the second search. Also tried adding another "FoundCells.Select" + "FoundCells2.Select" after the End With but the same happens.
Any help? (thinking a Union might be the solution?) Thanks in advance!

 

[JoeMo]

Welcome to the forum!

See if this does what you want for the terms "term", "term2" and "rec". Note that you are using xlPart in the lookAt argument so this will also select things like "terminator" and "record".

Sub FindStuff()
Dim c As Range, FoundCells As Range
Dim firstaddress As String
Dim What2Find As Variant, i As Long
Application.ScreenUpdating = False
What2Find = Array("term", "term2", "rec") 'set what you want to find here
With Sheets("Sheet1")
    For i = LBound(What2Find) To UBound(What2Find)
        Set c = .Cells.Find(What:=What2Find(i), After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
        xlPart, MatchCase:=False)
        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
                Set c = .Cells.FindNext(c)
                If c Is Nothing Then Exit Do
                If c.Address = firstaddress Then Exit Do
            Loop
        End If
    Next i
        If Not FoundCells Is Nothing Then
            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

 

[juk77]

Welcome to the forum!

See if this does what you want for the terms "term", "term2" and "rec". Note that you are using xlPart in the lookAt argument so this will also select things like "terminator" and "record".

Sub FindStuff()
Dim c As Range, FoundCells As Range
Dim firstaddress As String
Dim What2Find As Variant, i As Long
Application.ScreenUpdating = False
What2Find = Array("term", "term2", "rec") 'set what you want to find here
With Sheets("Sheet1")
    For i = LBound(What2Find) To UBound(What2Find)
        Set c = .Cells.Find(What:=What2Find(i), After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
        xlPart, MatchCase:=False)
        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
                Set c = .Cells.FindNext(c)
                If c Is Nothing Then Exit Do
                If c.Address = firstaddress Then Exit Do
            Loop
        End If
    Next i
        If Not FoundCells Is Nothing Then
            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

Works perfect, thank you!

 

[JoeMo]

Works perfect, thank you!

You are welcome - thanks for the reply.