ExcelBanter - Sorting By Value

Hello all,

I have a macro that looks in a col and and find what you asked and copy it to
sheet3. What I want is the macro instead of copying to sheet3 paste it on top
of sheet1 and delete the copied cell and bring the rows down. Something like
you sorting for value. for example, in sheet1 col. A has names and col.B is
number the program looks for a name and copy the whole row on top of the
sheet and delete the copied row.

Ex.

Sheet1:

sam 1
sam 2
sam 3
sam 4
sam 5
sam 6
sam 7
sam 8
sam 9
sam 10
sam 11
sam 12
tom 1
tom 2
tom 3
tom 4
tom 5
tom 6
tom 7
tom 8
tom 9
moe 1
moe 2
moe 3
moe 4
moe 5
moe 6
moe 7
moe 8
moe 9
moe 10

Results with the search of tom:

tom 1
tom 2
tom 3
tom 4
tom 5
tom 6
tom 7
tom 8
tom 9
sam 1
sam 2
sam 3
sam 4
sam 5
sam 6
sam 7
sam 8
sam 9
sam 10
sam 11
sam 12
moe 1
moe 2
moe 3
moe 4
moe 5
moe 6
moe 7
moe 8
moe 9
moe 10

Thank you.

Here is the VBA.

Public Sub FindStuff1()
Dim wksToSearch As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String
Dim wksDestination As Worksheet
Dim rngDestination As Range
Dim name As String
Dim col As String

col = InputBox("Enter A Column To Be Searched")
name = InputBox("Enter A Search Value")

Set wksDestination = Sheets("Sheet3") 'copy to
Set rngDestination = wksDestination.Range("A1")
Set wksToSearch = Sheets("Sheet1") 'Looks in
Set rngToSearch = wksToSearch.Columns(col) 'Looks in
Set rngFound = rngToSearch.Find(What:=name, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Sorry. Not found"
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
rngFoundAll.EntireRow.Copy rngDestination
End If
End Sub

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200712/1