PDA

View Full Version : Excel 2002 Find and copy to another worksheet"



TDK1966
08-17-2010, 01:40 PM
I have this code that works great. what I need to do is make this find copy to the next available row. I'd thank you immensely if you can help me with this. Might even come over and do your dishes for you for a week TEE HEE

Will

Sub Find()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet

Application.ScreenUpdating = False

intS = 3
Set wSht = Worksheets("Searched_Data")
strToFind = InputBox("Enter the search term you're looking for")
If strToFind = vbNullString Then Exit Sub

With ActiveSheet.Range("A4:L65536")
Set rngC = .Find(What:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
rngC.EntireRow.copy wSht.Cells(intS, 1)
intS = intS + 1
Set rngC = .FindNext(rngC)



Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With

End Sub

Artik
08-17-2010, 02:08 PM
Sub Find()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet

Application.ScreenUpdating = False

Set wSht = Worksheets("Searched_Data")
intS = Last(wSht.Columns(1)) + 1

strToFind = InputBox("Enter the search term you're looking for")
If strToFind = vbNullString Then Exit Sub

With ActiveSheet.Range("A4:L65536")
Set rngC = .Find(What:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
rngC.EntireRow.Copy wSht.Cells(intS, 1)
intS = intS + 1
Set rngC = .FindNext(rngC)



Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With

End Sub

Function Last(rng As Range)
'http://www.rondebruin.nl/last.htm
'Ron de Bruin, 5 May 2008

On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0

End Function
Artik

GTO
08-17-2010, 02:13 PM
I have this code that works great. what I need to do is make this find copy to the next available row.

Greetings Will,

Not tested, but I believe you can ditch Not rngC Is Nothing at the bottom of the loop. You are not changing the value of the found cell, thus it will continue to find ad infinitum. No harm if you leave it, just not necessary. You should IMO add .ScreenUpdating = True to the bottom of the procedure.

As to your question, what do you mean by ...find copy to the next row? Again, not tested, but the code appears to change the destination row.

mark