computing
  • 0

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

  • 0

 

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.

 

Share

0 Answers

  1. 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.

    • 0