Solved Excel Search Box And Copy All Results To Sheet # 1

Apple /
July 3, 2017 at 05:55:13
Specs: Macintosh
Hello,

I am using the exact codes stated below.

If possible, could you please let me know;

1) How or the additional codes necessary for having the same column heading always present in the search result sheet?
2) How could I start with the input box showing in order to initiate the running of the VBA code automatically?

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

Thank you
M.H.J


See More: Excel Search Box And Copy All Results To Sheet # 1

Reply ↓  Report •

✔ Best Answer
July 4, 2017 at 07:47:28
How did you solve the problem?

You can just add a button on the sheet which will call the FindCopy routine.

If you do not have the developer tab on your ribbon, do this

Go to

File>Options>Customize Ribbon - then tick developer in the right hand side list box

click ok to get out of that menu.

Now on your ribbon you will have the 'Developer' tab, click on it and select 'Insert' under ActiveX controls click on the first item which is a button, draw the button where you want on your sheet. Once its there double click it and within the code module insert this line.

Assuming sheet1 is where the original code is

Sheet1.FindCopy


So if your button is called

CommandButton21
then your code will look like

Private Sub CommandButton21_Click()
    Sheet1.FindCopy
End Sub

Now whenever you click on this the search box will appear.



#1
July 3, 2017 at 06:13:38
If I understand your question correctly, on the results sheet (Sheet2) you want to retain the headings? as the code currently stands it clears ALL the contents of sheet2, I have modified it so that it leaves the first row, usually the heading row. Give it a try

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
Sheets(2).Rows("2:" & Rows.Count).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


Reply ↓  Report •

#2
July 3, 2017 at 07:01:30
Hello,

Thank you for your prompt reply.

Unfortunately it did not work, and it still clears all the contents on sheet2.

Also if possible could you please let me know how could I start with the input box showing in order to initiate the running of the VBA code automatically?

Thank you


Reply ↓  Report •

#3
July 3, 2017 at 07:09:10
hmm that's very strange, the code works fine for me.

Sheets(2).Rows("2:" & Rows.Count).ClearContents

This is telling the code to clear all cells from row two to the end.


Try this instead though iv only changed

Sheets(2).Rows(......

to

Sheet2.Rows(.........

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
Sheet2.Rows("2:" & Rows.Count).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


Also if possible could you please let me know how could I start with the input box showing in order to initiate the running of the VBA code automatically?

What do you mean by this? are you saying that you want the inputbox to appear as soon as the workbook is open? please explain clearly what you mean.


Reply ↓  Report •

Related Solutions

#4
July 3, 2017 at 08:21:50
Hello again

Thank you for the alteration. The code works fine now.
Yes. That is exactly what I meant. I want the input box to appear as soon as the workbook is opened.

Thank you


Reply ↓  Report •

#5
July 3, 2017 at 08:59:27
Ok you will need to place the word 'Public' in front of your sub

So 'Sub FindCopy()'

Becomes

'Public Sub FindCopy'

Now double click on 'ThisWorkBook' module

And you can either use the dropdown menus and select 'Open' which will place the sub routine for the open event of the workbook, or paste my code below into the module, be warned i dont have Excel in front of me right now so i am guessing. If it doesnt work then just drop the menus down and select open then paste.

Private Sub ThisWorkBook_Open()

Sheet2.FindCopy

End Sub

If the code does not work then just copy the second line Sheet2.FindCopy into the Open event


Reply ↓  Report •

#6
July 3, 2017 at 21:11:39
Hello,

The last part with the "Public FindCopy' does not work.

Do you have any other solutions?


Reply ↓  Report •

#7
July 4, 2017 at 00:40:22
Yup, as I didn't have access to Excel I was guessing, the issue with the code above is that it was referencing the wrong sheet. You will need to reference the sheet in which the code is, I believe it may be sheet1. If its a module then just change the sheet reference to whatever the module name is

Private Sub Workbook_Open()
    Sheet1.FindCopy
End Sub


Reply ↓  Report •

#8
July 4, 2017 at 02:43:51
Hello,

Sorry to trouble you again.
I've followed all the instructions given, but unfortunately when I open the workbook the input box does not appear and I need to run the Macros to get the input box. Where as I would like to get the input box to initiate the macros to run.


Reply ↓  Report •

#9
July 4, 2017 at 03:25:36
You need to put the below code under 'ThisWorkBook' within project explorer

as mentioned you may need to change the reference from sheet1 to whichever sheet/module your other code (FindCopy) is.

Private Sub Workbook_Open()
    Sheet1.FindCopy
End Sub


Reply ↓  Report •

#10
July 4, 2017 at 04:38:15
Thank you so much for your help.

However, when I open the workbook, the input box flashes very quickly in the background and disappears.

Any ideas as to why this happens?


Reply ↓  Report •

#11
July 4, 2017 at 06:28:36
No idea what is going wrong iv just checked it on mine and its working as it should.... You could PM me your email address and I can send you the workbook I have.

Reply ↓  Report •

#12
July 4, 2017 at 07:19:49
Hi again,

I have solved the above problem.

But I need some further help with that once I have searched once, and whilst the worksheet is still open I would like to have the input box to appear again and allow the user to search as many time as s(he) wishes. Can you help me with the extra code for this action.

Thank you


Reply ↓  Report •

#13
July 4, 2017 at 07:47:28
✔ Best Answer
How did you solve the problem?

You can just add a button on the sheet which will call the FindCopy routine.

If you do not have the developer tab on your ribbon, do this

Go to

File>Options>Customize Ribbon - then tick developer in the right hand side list box

click ok to get out of that menu.

Now on your ribbon you will have the 'Developer' tab, click on it and select 'Insert' under ActiveX controls click on the first item which is a button, draw the button where you want on your sheet. Once its there double click it and within the code module insert this line.

Assuming sheet1 is where the original code is

Sheet1.FindCopy


So if your button is called

CommandButton21
then your code will look like

Private Sub CommandButton21_Click()
    Sheet1.FindCopy
End Sub

Now whenever you click on this the search box will appear.


Reply ↓  Report •

#14
July 5, 2017 at 05:03:14
Thank you so much.

You were great help


Reply ↓  Report •

#15
July 5, 2017 at 05:32:11
Not a problem at all, glad we could help.

Reply ↓  Report •

Ask Question