Before we switch to e-mail, try the following which is a tinkered version of the original that I linked to:<pre>
Sub Search_Sht()
'Macro recorded by Nate
Dim sht As Worksheet, act As Range, act2 As Range, srcBk As Workbook
Dim o As Long, frst As Range, cnt As Integer
Dim myVal, myWkbk As Workbook, mySht As Integer, sRc As String
'change a65536 to an appropriate column
myVal = Application.InputBox("Please Enter City Name", Type:=2)
If myVal = False Then Exit Sub
Set srcBk = ThisWorkbook
sRc = ThisWorkbook.ActiveSheet.Name
Set myWkbk = Workbooks.Add 'Change the target Workbook name here
mySht = 1 'Change the target sheet index here
o = myWkbk.sheets(mySht).[a65536].End(xlUp)(2).Row
Set act = ThisWorkbook.sheets(sRc).Cells.Find(What:=myVal, _
after:=[iv65536], LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not act Is Nothing Then
act.EntireRow.Copy myWkbk.sheets(mySht).Rows(o)
myWkbk.sheets(mySht).Cells(o, 1).AddComment _
Text:="Result Location: " & _
sheets(sRc).Name & "!" & act.Address(False, False)
o = o + 1
Set frst = act
again:
Set act2 = ThisWorkbook.sheets(sRc).Cells.FindNext(act)
If Not act2 Is Nothing Then
If act2.Address<> act.Address _
And act2.Address<> frst.Address Then
act2.EntireRow.Copy _
myWkbk.sheets(mySht).Rows(o)
myWkbk.sheets(mySht).Cells(o, 1).AddComment _
Text:="Result Location: " & _
sheets(sRc).Name & "!" & act2.Address(False, False)
o = o + 1
Set act = act2
GoTo again
End If
End If
End If
End Sub</pre><pre></pre>
Hopefully this will perform as expected. Enter the city name, and then do a quick sort on your new workbook.
_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-10-16 15:02