PDA

View Full Version : Change code to search multiple terms across columns



earthandbody
01-23-2019, 12:47 PM
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

p45cal
01-23-2019, 06:16 PM
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?

earthandbody
01-24-2019, 01:12 PM
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.

p45cal
01-24-2019, 04:02 PM
Supply a workbook with sample data.

earthandbody
01-24-2019, 04:36 PM
Sample file with data.

大灰狼1976
01-25-2019, 08:38 PM
Hi earthandbody! If my understanding is correct...
The content of B2 is separated by a comma.
for example: B2 = ROCK,JOHNSON

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

earthandbody
01-25-2019, 09:51 PM
A lot of the data will be separated by commas.

Fluff
01-26-2019, 12:48 PM
Cross posted https://www.mrexcel.com/forum/excel-questions/1084876-change-code-search-multiple-terms-across-columns.html

p45cal
01-30-2019, 11:09 AM
See if the attached is any use (Sheet Search2).

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