Keyword search and copy row to new sheet: search term problem

Hi guys,

So I created the following code to act as a search function for keywords in an open sheet. When it finds that word, it copies the entire row to another sheet. Unfortunately at the moment it only works if a word is on it's own in a cell (rather than in a sentence for example). Can someone help to fix this so that it also searches for, and copies, rows with that word anywhere in the text?

P.s. some of the code might be redundant because I'm teaching myself and I have been playing around with it for a while.

Option Explicit
Sub CopyPaste()
Application.ScreenUpdating = True
Dim vSearch As Variant
vSearch = InputBox("Search")

'this variable holds a search phrase, declared as variant as it might be text or number

Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'the macro prompts a user to enter the search phrase
For xRow = 1 To LastRow

If WorksheetFunction.CountIf(Rows(xRow), vSearch) > 0 Then
Rows(xRow).Copy Sheets("SearchResults").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True
End Sub

I think you just need a minor tweak to your code.

If WorksheetFunction.CountIf(Rows(xRow), "*" & vSearch & "*") > 0 Then

Try This

That's super - thanks a lot!!