<\/p>\n
Good day..<\/p>\n
I’ve searched for an Excel macro that does the following :<\/p>\n
1. Press a button to open a search box
\n2. All results found to be copied to sheet # 2<\/p>\n
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.<\/p>\n
Thanks a lot…<\/p>\n
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.<\/p>\n
I’ll keep looking…<\/p>\n
Option Explicit\r\nSub FindCopy()\r\nDim myString, firstAddress As String\r\nDim nxtRw As Long\r\nDim c As Range\r\nDim tryAgain As Boolean\r\nDim mySize As String\r\nstartSearch:\r\n'Get input from user\r\n myString = Application.InputBox(\"Enter A Search String\")\r\n'Exit if Cancelled\r\n If myString = False Then Exit Sub\r\n'Force valid entry\r\n If myString = \"\" Then\r\n If MsgBox(\"The Search Field Can Not Be Left Blank\" _\r\n & vbLf & vbLf & \"Do You Want To Try Again?\", vbYesNo + vbQuestion) = _\r\n vbNo Then Exit Sub\r\n GoTo startSearch\r\n End If\r\n'Set lookat value based on Search String length\r\n If MsgBox(\"Exact Match Only? \" & vbCrLf & vbCrLf & _\r\n \"Yes For Exact Match Of \" & myString & vbCrLf & vbCrLf & _\r\n \"No For Any Match Of \" & myString, vbYesNo + vbQuestion) = _\r\n vbYes Then mySize = xlWhole Else mySize = xlPart\r\n'Search entire sheet\r\n With Sheets(1).Cells\r\n Set c = .Find(myString, LookIn:=xlValues, LookAt:=mySize)\r\n'Perform Copy\/Paste\/FindNext if myString is found\r\n If Not c Is Nothing Then\r\n firstAddress = c.Address\r\n'Clear Sheet2\r\n Sheets(2).Cells.ClearContents\r\n Do\r\n'Find next empty Row in Sheet2 Column A\r\n nxtRw = Sheets(2).Range(\"A\" & Rows.Count).End(xlUp).Row + 1\r\n'Copy entire Row to next empty Row in Sheet 2\r\n c.EntireRow.Copy _\r\n Destination:=Sheets(2).Range(\"A\" & nxtRw)\r\n'Search again\r\n Set c = .FindNext(c)\r\n Loop While Not c Is Nothing And c.Address <> firstAddress\r\n Else:\r\n If MsgBox(\"Search String Not Found\" & vbCrLf & vbCrLf & _\r\n \"Do You Want To Try Again?\", vbYesNo + vbQuestion) = _\r\n vbNo Then Exit Sub\r\n GoTo startSearch\r\n End If\r\n End With\r\nEnd Sub<\/pre>\n