You got me???
Is there an "End If" following the statement?
Do you have more than on sheet selected when the code is run?
The following version eliminates the creation of the worksheet if
nothing is found. You might try it and see if the problem still occurs.
--
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html
Sub CopyFoundStuff()
'Modified by Jim Cone on August 31, 2006 to find multiple words.
Dim wksCopyTo As Excel.Worksheet
Dim wksCopyFrom As Excel.Worksheet
Dim rngToSearch As Excel.Range
Dim rngFound As Excel.Range
Dim rngFoundAll As Excel.Range
Dim rngCombined As Excel.Range
Dim strFirstAddress As String
Dim varWords As Variant
Dim lngN As Long
varWords = Array("This", "That", "Whatever")
Set wksCopyFrom = Sheets("Sheet1")
Set rngToSearch = wksCopyFrom.Columns("A")
For lngN = 0 To UBound(varWords)
Set rngFound = rngToSearch.Find(What:=varWords(lngN), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry " & varWords(lngN) & " was not found."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Application.Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
If rngCombined Is Nothing Then
Set rngCombined = rngFoundAll
Else
Set rngCombined = Application.Union(rngCombined, rngFoundAll)
End If
End If
Next 'lngN
If Not rngCombined Is Nothing Then
Set wksCopyTo = Worksheets.Add(Count:=1)
rngCombined.EntireRow.Copy wksCopyTo.Range("A2")
End If
End Sub
'----------------
"John Hughes"
wrote in message
Thank you Jim! It seems to be working except for the last line. The debugger
goes to this statement:
If Not rngCombined Is Nothing Then
rngCombined.EntireRow.Copy wksCopyTo.Range("A2")