How to select, copy and paste rows from a find operation

**Lambertatg** · 04-27-2013, 07:07 AM

I have the following code that finds the string in the following VBA code. The problems is I have to re-enter the search string every time the macro runs. How can I adjust this code to select, copy and paste (as it does for the first string it finds) all the remaining rows relevant to the this search string?

Dim lngNextRow As Long
Dim strMyString As String
Sheets("ww1186").Activate

strMyString = InputBox("Enter the number you wish to find")

On Error GoTo err_Trap

Cells.Find(What:=strMyString, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate

ActiveCell.EntireRow.Copy

Sheets("Sheet1").Select
lngNextRow = Range("A" & rows.Count).End(xlUp).Row + 1
Range("A" & lngNextRow).PasteSpecial

err_Trap:
If Err.Number = 91 Then
MsgBox "Could not find " & strMyString & " anywhere on this sheet.", , "Unsuccessful search"

Can someone please help?
Many thanks
Lambert

**NeedForExcel** · 04-27-2013, 07:30 AM

You will probably have to use "For Next" for this one.

Can you attach a Sample Workbook?

Thank You,

Deep

**Lambertatg** · 04-29-2013, 06:19 AM

Hi Holger,

Wow!!! this code really works very well indeed. Thanks a million. I have learnt a valuable lesson in how to loop with the boolean type of variable. I would not dreamed of using a boolean this way. Yes, guilty as charged...the comments about "Code Tags". I'll get this sorted right away.

thanks again

Lambert

**HaHoBe** · 04-27-2013, 07:31 AM

Hi, Lambert,

could you please wrap the code with Code-Tags?

Please try if this is what you are looking for

Sub EF918610()
Dim lngNextRow As Long
Dim strMyString As String
Dim strAddress As String
Dim rngFound As Range
Dim blnLoop As Boolean

strMyString = InputBox("Enter the number you wish to find")
With Sheets("Sheet1")
  lngNextRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With

With Sheets("ww1186")
  Set rngFound = .Cells.Find(What:=strMyString, after:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
  If Not rngFound Is Nothing Then
    strAddress = rngFound.Address
    blnLoop = True
    Sheets("Sheet1").Rows(lngNextRow).Value = rngFound.EntireRow.Value
    lngNextRow = lngNextRow + 1
    Do While blnLoop
      Set rngFound = .Cells.FindNext(after:=rngFound)
      If rngFound.Address <> strAddress Then
        Sheets("Sheet1").Rows(lngNextRow).Value = rngFound.EntireRow.Value
        lngNextRow = lngNextRow + 1
      Else
        blnLoop = False
      End If
    Loop
  Else
    MsgBox "Could not find " & strMyString & " anywhere on this sheet.", , "Unsuccessful search"
  End If
End With
End Sub

Ciao,
Holger