Look for keywords and copy to another sheet

I currently have a working code that does exactly what I want it to do, loops through a particular part of an excel document looking for certain keywords, then pasting those keywords into a separate sheet in the excel spreadsheet. It is just very long and doesn't allow for any more than 20 repetitions. I was wondering if anyone had advice on making this code loop until the user selects vbNo when asked if they have any more keywords?

```
Option Compare Text

Sub Macro2()
'
' Macro2 Macro
'
' Keyboard Shortcut: Ctrl+h
'
Application.ScreenUpdating = False
Dim lastLine As Long
Dim findWhat As String
Dim toCopy As Boolean
Dim cell As Range
Dim i As Long
Dim j As Long

findWhat = CStr(InputBox("What word would you like to search for today?"))
lastLine = ActiveSheet.UsedRange.Rows.Count
If findWhat = "" Then Exit Sub
j = 1
s = 2

For i = 1 To lastLine
For Each cell In Range("BU1").Offset(i - 1, 0)
If InStr(cell.Text, findWhat) <> 0 Then
toCopy = True
End If
Next
If toCopy = True Then

Rows(i).Copy Destination:=Sheets(s).Rows(j)
j = j + 1
End If
toCopy = False
Next
s = s + 1

If MsgBox(((j - 1) & " results were copied, do you have more keywords to enter?"), vbYesNo + vbQuestion) = vbNo Then Exit Sub

findWhat = CStr(InputBox("What word would you like to search for today?"))
lastLine = ActiveSheet.UsedRange.Rows.Count
If findWhat = "" Then Exit Sub
j = 1
For i = 1 To lastLine
For Each cell In Range("BU1").Offset(i - 1, 0)
If InStr(cell.Text, findWhat) <> 0 Then
toCopy = True
End If
Next
If toCopy = True Then
Rows(i).Copy Destination:=Sheets(s).Rows(j)
j = j + 1
End If
toCopy = False
Next
s = s + 1
If MsgBox(((j - 1) & " results were copied, do you have more keywords to enter?"), vbYesNo + vbQuestion) = vbNo Then Exit Sub

findWhat = CStr(InputBox("What word would you like to search for today?"))
lastLine = ActiveSheet.UsedRange.Rows.Count
If findWh

• Instead of hard coding x number of searches, add a loop (I used a While...Wend) that repeats until the user enters a blank search term. This will allow them to search for as few or as many words as they need to on this run.

• Instead of looping through all the cells of the worksheet, using the .Find() method will be much, much faster. There are a couple of caveats

• .Find() uses the current Find settings exactly as they are in the find dialog box, so you'll want to set as many of the parameters as are important to you. I've set a minimum in the code sample - you may need more

• .Find() will continue looping through your workbook with no warning that it's returned to the top, so you need to store off the address of your first found item & compare it each time through.

Something like this:

'Application.ScreenUpdating = False
Dim lastLine As Long
Dim toCopy As Boolean
Dim cell As Range

Dim findWhat As String
Dim i As Long
Dim j As Long
Dim rng as Range
Dim Address as string

s = 2
findWhat = CStr(InputBox("What word would you like to search for today?"))
While Len(FindWhat)> 0  'loop until they enter a blank search string
  j = 1
  rng = ActiveSheet.Find(What:=findWhat, LookIn:=xlValues)
  if not rng is Nothing and rng.address <> address then 'if we found something & it's not the first cell we found
    if len(address) = 0 then 'if this is our first find
      address = rng.address  'store the cell address so we don't loop forever
    end if
    rng.copy destination:=Sheets(s).Rows(j)
    j = j+1
    rng = ActiveSheet.Find(What:=findWhat, LookIn:=xlValues)
  end if

  s = s + 1

  MsgBox j - 1 & " results were copied"
  findWhat = CStr(InputBox("What other word would you like to search for today?"))
Wend

StackExchange Code Review Q#86790, answer score: 6