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