How do I add addtional textstrings, i.e. "this2", "that" , "whatever", to
the statement listed below? I am trying to search a range to find cells that
contain different names.


Set rngFound = rngToSearch.Find(What:="this", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)

My initial reaction is to suggest that you run a separate search
for each string required. Then use Application.Union to put them all together.

Set rngCombined = Application.Union(rngFound, rngFound2, rngFound3)
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"John Hughes"

wrote in message
How do I add addtional textstrings, i.e. "this2", "that" , "whatever", to
the statement listed below? I am trying to search a range to find cells that
contain different names.

Set rngFound = rngToSearch.Find(What:="this", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)

Modified code shown below.
You get an extra sheet added no matter if any words are found.
The code uses "Sheet1" as the name of the sheet containing your data.
Change "Sheet1" to the actual name of your sheet.

Add or subtract words you are trying to find in this line of the code ...
varWords = Array("This", "That", "Whatever")

For help on getting started with macros, see ...
http://www.mvps.org/dmcritchie/excel/getstarted.htm

I think I will keep the modified code for possible future use.
Do you know who wrote original version? It's nicely done.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Public 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 wksCopyTo = Worksheets.Add
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
rngCombined.EntireRow.Copy wksCopyTo.Range("A2")
End If
End Sub
'-----------



"John Hughes"

wrote in message
Okay maybe you can assist me further in the process. (This is my first
time using a macro.)
Here is the complete macro supplied to me. How do I write a separate
search, where do I place it, etc? Thanks for your help!

-snip-

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")




"Jim Cone" wrote:

Modified code shown below.
You get an extra sheet added no matter if any words are found.
The code uses "Sheet1" as the name of the sheet containing your data.
Change "Sheet1" to the actual name of your sheet.

Add or subtract words you are trying to find in this line of the code ...
varWords = Array("This", "That", "Whatever")

For help on getting started with macros, see ...
http://www.mvps.org/dmcritchie/excel/getstarted.htm

I think I will keep the modified code for possible future use.
Do you know who wrote original version? It's nicely done.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Public 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 wksCopyTo = Worksheets.Add
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
rngCombined.EntireRow.Copy wksCopyTo.Range("A2")
End If
End Sub
'-----------



"John Hughes"

wrote in message
Okay maybe you can assist me further in the process. (This is my first
time using a macro.)
Here is the complete macro supplied to me. How do I write a separate
search, where do I place it, etc? Thanks for your help!

-snip-

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")