Change code to search multiple terms across columns

Hello,

I have this code that I need modified to search more than one term at a time. I need it to search everything from columns A to P.

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim sAddr As String
Dim LastRow1 As Long
LastRow1 = Sheets("Search").Range("A" & Rows.Count).End(xlUp).Row + 1
Dim LastRow2 As Long
LastRow2 = Sheets("2014-2019").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets("Search").Range("A5:P" & LastRow1).ClearContents
Dim searchVal As Range
With Sheets("2014-2019").Range("A2:P" & LastRow2)
Set searchVal = .Find(Target, LookIn:=xlValues, LookAt:=xlPart)
If Not searchVal Is Nothing Then
sAddr = searchVal.Address
Do
searchVal.EntireRow.Copy
ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Set searchVal = .FindNext(searchVal)
Loop While searchVal.Address <> sAddr
sAddr = ""
End If
End With
Set searchVal = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Thanks in advance

Quote:

---

Originally Posted by earthandbody

I have this code that I need modified to search more than one term at a time.

---

At the moment it searches columns A to P for the term in cell B2. Where are the other terms sought for located?

Quote:

---

Originally Posted by p45cal

At the moment it searches columns A to P for the term in cell B2. Where are the other terms sought for located?

---

The columns have data like delivery location, description, vendor, buyer name, etc. I may have pieces of each and want to enter what I have and have it search and find the rows that contain all of the search string.

Supply a workbook with sample data.

Sample file with data.

Hi earthandbody! If my understanding is correct...
The content of B2 is separated by a comma.
for example: B2 = ROCK,JOHNSON

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim sAddr As String
    Dim LastRow1 As Long
    LastRow1 = Sheets("Search").Range("A" & Rows.Count).End(xlUp).Row + 1
    Dim LastRow2 As Long
    LastRow2 = Sheets("2014-2019").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Search").Range("A5:P" & LastRow1).ClearContents
    Dim searchVal As Range, arr, i&, j&
    With Sheets("2014-2019")
        arr = Split(Target, ",")
        For i = 2 To LastRow2
            For j = 0 To UBound(arr)
                Set searchVal = .Rows(i).Find(arr(j), LookIn:=xlValues, LookAt:=xlPart)
                If Not searchVal Is Nothing Then
                    searchVal.EntireRow.Copy
                    ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    Exit For
                End If
            Next j
        Next i
    End With
    Set searchVal = Nothing
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

---

A lot of the data will be separated by commas.

Cross posted https://www.mrexcel.com/forum/excel-...s-columns.html

See if the attached is any use (Sheet Search2).

Regarding cross posting see http://www.excelguru.ca/content.php?184