Search column for string and return every row with that string in new sheet

**myers601** · 07-03-2012, 04:13 PM

Hi All,

I want to search column B for "Dog" and return then copy every row with "Dog" in column B to a new sheet. The solution would be to return AB in A1, Red Dog in B1, CD in A2, and Blue Dog in B2. This example is much simpler, but you can see my progress in the code below:

Please help!

Sub search_Click()
Dim strFind As String
Dim NextRow As Long
Dim rngFound As Range
Dim wsSource As Worksheet, wsResult As Worksheet

Set wsSource = Sheets("Sheet1")
Set wsResult = Sheets("Sheet2")

With wsSource
strFind = .Range("C2").Value
Set rngFound = .Range("B1:B15000").Find(What:=strFind, LookAt:=xlPart)
If Not rngFound Is Nothing Then
NextRow = wsResult.Range("B" & Rows.Count).End(xlUp).Row + 1
rngFound.EntireRow.Copy wsResult.Range("A" & NextRow)
End If
End With

End Sub

AB	Red Dog
CD	Blue Dog
EF	Yellow Cat

**Chippy** · 07-03-2012, 06:02 PM

Try this AutoFilter code, which will be much faster than a Find-FindNext loop. You need to put column headings in row 1 of the source sheet for this method to work.

Sub Filter()
        
    Dim wsSource As Worksheet, wsResult As Worksheet
    
    Set wsSource = Sheets("Sheet1")
    Set wsResult = Sheets("Sheet2")
        
    wsResult.Cells.ClearContents
    
    With wsSource
    
        'AutoFilter on column B (field 2) containing dog
                
        .Cells.AutoFilter Field:=2, Criteria1:="=*dog*"
        
        'Copy filtered rows to result sheet
        
        .AutoFilter.Range.Copy wsResult.Range("A1")

        'Turn off autofilter
    
        .Cells.AutoFilter
    End With

End Sub

Obviously the Criteria1:="=*dog*" part can be modified to use a search string in a cell.