Hi Harlan,

I did want only r & x, but then realized that if I needed to add/delete a
column in between them I'd have to adjust the code each time. By putting in
the range, it is working much better. Thank you very much to all that have
replied! Cathy

"Harlan Grove" wrote:

Cathy Landry wrote...
....
Here's the code that I'm using courtesy of Jindon. For anyone else that's
looking to extract text within text this is perfect.

Sub FindAndCopy()
Dim r As Range, i As Long
Dim Phrase
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Phrase = Array("gift", "check", "wrong")
With ws1

For Each r In Intersect(.Range("r:x"), .UsedRange)

This uses all columns between columns R and X, inclusive. Your previous
follow-up made it seem you wanted to look through only columns R and X.

For i = LBound(Phrase) To UBound(Phrase)
If InStr(1, r, Phrase(i), vbTextCompare) 0 Then
r.EntireRow.Copy _
ws2.Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next
End With
MsgBox "done"
Application.CutCopyMode = False
End Sub
....

You could use a macro for this, but it'd be simpler to do this with an
advanced filter. All columns in your original table would need field
names in the top row. You'd then need a criteria range with the field
names for columns R and X in another range and the words to match in
separate rows as follows.


Col_R_Field Col_X_Field
*gift*
*check*
*wrong*
*gift*
*check*
*wrong*


Filter in place, copy the filtered rows, and paste into another
worksheet.