Solved Excel search box and copy all results to sheet # 2

Good day..

I’ve searched for an Excel macro that does the following :

1. Press a button to open a search box
2. All results found to be copied to sheet # 2

This would work similarly to a web search engine, where all found results appear. I’ve seen quite similar examples here in the community, but search parameters must be included beforehand in the macro contents. I need one that is flexible and allows me to use a search box for whatever text string I need to find in each case.

Thanks a lot…

I’ll let you know right up front that if I were a user, I would not like the way the following macro works, but it does what you’ve asked. I’ve look around for a Forms method that accepts both a text input from a user as well as a “radial button” choice, but as I said my Forms skills are minimal.

I’ll keep looking…

Option Explicit
Sub FindCopy()
Dim myString, firstAddress As String
Dim nxtRw As Long
Dim c As Range
Dim tryAgain As Boolean
Dim mySize As String
startSearch:
'Get input from user
   myString = Application.InputBox("Enter A Search String")
'Exit if Cancelled
     If myString = False Then Exit Sub
'Force valid entry
     If myString = "" Then
       If MsgBox("The Search Field Can Not Be Left Blank" _
       & vbLf & vbLf & "Do You Want To Try Again?", vbYesNo + vbQuestion) = _
                        vbNo Then Exit Sub
          GoTo startSearch
     End If
'Set lookat value based on Search String length
    If MsgBox("Exact Match Only? " & vbCrLf & vbCrLf & _
              "Yes For Exact Match Of " & myString & vbCrLf & vbCrLf & _
              "No For Any Match Of " & myString, vbYesNo + vbQuestion) = _
                        vbYes Then mySize = xlWhole Else mySize = xlPart
'Search entire sheet
      With Sheets(1).Cells
        Set c = .Find(myString, LookIn:=xlValues, LookAt:=mySize)
'Perform Copy/Paste/FindNext if myString is found
          If Not c Is Nothing Then
             firstAddress = c.Address
'Clear Sheet2
  Sheets(2).Cells.ClearContents
           Do
'Find next empty Row in Sheet2 Column A
             nxtRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
'Copy entire Row to next empty Row in Sheet 2
               c.EntireRow.Copy _
                 Destination:=Sheets(2).Range("A" & nxtRw)
'Search again
             Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
          Else:
            If MsgBox("Search String Not Found" & vbCrLf & vbCrLf & _
                      "Do You Want To Try Again?", vbYesNo + vbQuestion) = _
                        vbNo Then Exit Sub
                GoTo startSearch
          End If
      End With
End Sub

Click Here Before Posting Data or VBA Code —> How To Post Data or Code.