How do you pass a cell or range into InStr? - excel

Question

I'm trying to copy rows from one worksheet to another based on whether a string exists in a specific cell of each row. In the below example, I'm searching for Jordan in Column J. If that name is in this particular rows Column J, it gets moved to a different sheet (Final Sheet).
Sub Test()
Worksheets("All Data").Activate
Dim N As Long, i As Long
N = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To N
If InStr(1, Cells(i, "J"), "Jordan") > 0 Then
Worksheets("All Data").Rows(i).Copy
Worksheets("Final Sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next i
End Sub
What I want to do is look for multiple strings. I can accomplish this by adding as many "Or" are needed like below.
If InStr(1, Cells(i, "J"), "Jordan") > 0 Or InStr(1, Cells(i, "J"), "Barkley") > 0 Then
I usually have 5+ strings i'm searching for and it becomes difficult to update the code each time. I would rather the strings I look for be located in a range of cells on some hidden sheet that I or someone can update easily. I've been tinkering with the below. Range does work if its a single cell. If its more such as A1:A5 then it breaks. Any thoughts on how I could accomplish this? Am I totally missing an elegant solution?
Sub Test()
Worksheets("All Data").Activate
Dim N As Long, i As Long
N = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To N
If InStr(1, Cells(i, "J"), Worksheets("List").Range("A1:A5")) > 0 Then
Worksheets("All Data").Rows(i).Copy
Worksheets("Final Sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next i
End Sub
List Sheet
- | A |
1 | Jordan |
2 | Barkley |
3 | Batman |
4 | Robin |
5 | Ozzy |

Answer 1

Based on this previous answer, I customize it to your scenario
Remember to backup your data before running it.
Read the code's comments and adjust the variables' values to fit your needs.
Public Sub CopyData()
' Define the object variables
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
Dim listRange As Range
Dim evalCell As Range
' Define other variables
Dim listRangeAddress As String
Dim startSourceRow As Long
Dim lastSourceRow As Long
Dim columnForLastRowSource As Long
Dim lastTargetRow As Long
Dim sourceRowCounter As Long
Dim columnForLastRowTarget As Long
Dim columnToEval As Long
''''' Adjust the folloing values ''''
' Set the lookup list range address
listRangeAddress = "B1:B5"
' Adjust the worksheets names
Set sourceWorksheet = ThisWorkbook.Worksheets("All Data")
Set targetWorksheet = ThisWorkbook.Worksheets("Final Sheet")
Set listRange = ThisWorkbook.Worksheets("List").Range(listRangeAddress)
' Set the initial row where data is going to be evaluated
startSourceRow = 1
' Set the column from which you're going to get the last row in sourceSheet
columnForLastRowSource = 1
' Set the column from which you're going to get the last row in targetSheet
columnForLastRowTarget = 1
' Set the column where you evaluate if condition is met
columnToEval = 10
'''''''Loop to copy rows that match'''''''
' Find the number of the last row in source sheet
lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, columnForLastRowSource).End(xlUp).Row
For sourceRowCounter = startSourceRow To lastSourceRow
For Each evalCell In listRange.Cells
' Evaluate if criteria is met in column
If InStr(sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value, evalCell.Value) > 0 Then
' Get last row on target sheet (notice that this search in column A = 1)
lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, columnForLastRowTarget).End(xlUp).Row
' Copy row to target
sourceWorksheet.Rows(sourceRowCounter).Copy targetWorksheet.Rows(lastTargetRow + 1)
' If found, don't keep looking
Exit For
End If
Next evalCell
Next sourceRowCounter
End Sub
Let me know if it works and remember to mark the answer if it does.