Thread: Search specific column and then copy to new sheet

Hello again,

I need a way so that I can press a button and then a box will appear and allow me to type a search word. It will then scan a particular column if it contains that word and then it will copy the entire row and paste it into a new sheet.

It must be able to handle multiple search terms.

So: If I have multiple names like "John Smith" and then 20 rows down I have John Smith again and then another 10 times it has John Smith in that column, then it will copy the entire row in which john smith is within, (All of them) and paste them into a new sheet.

It should copy the entire row including the columns before, because the column where it is searching for will mostly likely not be column A.

Thank's again

~JSN

Give this a try. You did not specify which column to search in so this code assumes you want to search in the active cell column. This code uses filtering to copy all (exact) occurrences of the search term to Sheet2.

Option Explicit

Sub Find_and_Copy()

    Dim lastrow As Long, lCol As Long, sCriteria As String
    
    lCol = ActiveCell.Column
    lastrow = Cells(Rows.Count, lCol).End(xlUp).Row
    
    sCriteria = Application.InputBox("Enter a search term", Type:=2)
    
    If sCriteria = vbNullString Then Exit Sub
        
    Application.ScreenUpdating = False
    
    With Sheet1
        .AutoFilterMode = False
        If WorksheetFunction.CountIf(.Range(.Cells(1, lCol), .Cells(lastrow, lCol)), sCriteria) < 1 Then
            MsgBox "The search term is not listed in the active cell column"
            Exit Sub
        End If
        .Range(.Cells(1, lCol), .Cells(lastrow, lCol)).AutoFilter field:=1, Criteria1:="=" & sCriteria
        .Range(.Cells(1, lCol), .Cells(lastrow, lCol)).SpecialCells(xlCellTypeVisible).Copy Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        .AutoFilterMode = False
    End With
    
    Application.ScreenUpdating = True

End Sub

The code above DOES NOT create a Pivot Table . As I stated - it applies filtering, which is not the same.

Code below is revised per your last post to look only in column-D.

Option Explicit

Sub Find_and_Copy()

    Dim lastrow As Long, sCriteria As String
    
    lastrow = Cells(Rows.Count, "D").End(xlUp).Row
    
    sCriteria = Application.InputBox("Enter a search term", Type:=2)
    
    If sCriteria = vbNullString Then Exit Sub
        
    Application.ScreenUpdating = False
    
    With ActiveSheet
        .AutoFilterMode = False
        If WorksheetFunction.CountIf(.Range("D1:D" & lastrow), sCriteria) < 1 Then
            MsgBox "The search term is not listed in the column"
            Exit Sub
        End If
        .Range("D1:D" & lastrow).AutoFilter field:=1, Criteria1:="=" & sCriteria
    End With
    
    Application.ScreenUpdating = True

End Sub

Also one last thing, to make a button which would reset the pivot table to show all.

You can turn the filter off via the menu. However, here is code which you can use to do this. Just create a button and assign this macro to the button.

Sub Clear_Filter()

    With ActiveSheet
        .AutoFilterMode = False
    End With

End Sub