NeedsomeHelp
New Member
- Joined
- Jul 12, 2022
- Messages
- 6
- Office Version
- 2019
- 2016
- 2013
- Platform
- Windows
Hi,
What I'm trying to do is use a keyword e.g. "Spotless" and with that keyword find any cell in the source data sheet with that keyword (could be in the middle of the word, end, start thats why it has wildcards) and if it has that keyword copy and paste the whole row in a new sheet.
The problem i have with the code now is that it will only work for one keyword How do i get it to work with multiple keywords say i want the keywords "spotless" "food" and "face" what would i need to do for the code to pick up all three keywords and copy and paste those in a new sheet.
If it is possible as well would i be able to use a different sheet named Keywords which would have a single column with different keywords in the column and the code would search for all the keywords in the column one after the other and copy and paste it in a new sheet.
What I'm trying to do is use a keyword e.g. "Spotless" and with that keyword find any cell in the source data sheet with that keyword (could be in the middle of the word, end, start thats why it has wildcards) and if it has that keyword copy and paste the whole row in a new sheet.
The problem i have with the code now is that it will only work for one keyword How do i get it to work with multiple keywords say i want the keywords "spotless" "food" and "face" what would i need to do for the code to pick up all three keywords and copy and paste those in a new sheet.
If it is possible as well would i be able to use a different sheet named Keywords which would have a single column with different keywords in the column and the code would search for all the keywords in the column one after the other and copy and paste it in a new sheet.
VBA Code:
[
Sub Test1()
Application.ScreenUpdating = True
Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*Spotless*") > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True
End Sub
]