Find Value in cell via Inputbox, copy row, paste in new worksheet

[lthursdayl]

Hello Everyone,
I have been trying to write a macro in VB that will search for a word in a cell, the word would be input by the user via a inputbox, search the entire worksheet, then copy the entire row the word is found on, and paste the row into a new worksheet that is part of the same workbook. I am not attaching the code I have been working on because it is awful and I think I have been going about this in the wrong way. Any help is greatly appreciated.
Thanks in advance.

 

[jason_joel]

Hi Tom,

Here is the clarification - I hope I did my best to give a brief explanation.

• When you say "command button" do you mean a button from the activex control toolbox that was drawn onto the sheet, maybe the button is named CommandButton1, as opposed to a button drawn from the Forms toolbar.
- Yes I have a command button which is connected to the macro that you gave in this post as below:
Sub Test2()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub

Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True

MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

• Is there any column in particular on Sheet 2 where this keyword would only need to be searched for, or can it exist anywhere among columns A:H.
No particular column, it can search through the whole dataset in sheet 2
-
• Is this keyword alone in the cell, or part of another longer string. Example, if the keyword is "stop" should only a cell with "stop" have its row copied, or if the cell holds "I stop for pedestrians" or "The rain was unstoppable" should that also be copied.
I basically need the whole rows to be copied like how it functions in the macro code that you gave, to clarify the above marked in green is what I want.

Currently I only need a function like, clicking the button multiple times should not copy the data overlapping the existing ones.
For example - your macro code copy pastes the entire rows corresponding to the keyword (which is right), all I need is if am running the macro the second time, I want the data to sit in the next blank row when it is copy pasted.

Thanks for taking time on this.

 

[jason_joel]

Hi Tom,

Here is the clarification - I hope I did my best to give a brief explanation.

• When you say "command button" do you mean a button from the activex control toolbox that was drawn onto the sheet, maybe the button is named CommandButton1, as opposed to a button drawn from the Forms toolbar.
- Yes I have a command button which is connected to the macro that you gave in this post as below:
Sub Test2()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub

Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True

MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

• Is there any column in particular on Sheet 2 where this keyword would only need to be searched for, or can it exist anywhere among columns A:H.
No particular column, it can search through the whole dataset in sheet 2
-
• Is this keyword alone in the cell, or part of another longer string. Example, if the keyword is "stop" should only a cell with "stop" have its row copied, or if the cell holds "I stop for pedestrians" or "The rain was unstoppable" should that also be copied.
I basically need the whole rows to be copied like how it functions in the macro code that you gave, to clarify the above marked in green is what I want.

Currently I only need a function like, clicking the button multiple times should not copy the data overlapping the existing ones.
For example - your macro code copy pastes the entire rows corresponding to the keyword (which is right), all I need is if am running the macro the second time, I want the data to sit in the next blank row when it is copy pasted.

Thanks for taking time on this.

 

[akynyemi]

Hi Tom,

I was searching for a VBA Code online and came across yours and its wonderfully written, you've done a very good job. I however need an amendment to the code. I need your assistance to write the code to search through only one column e.g. ("L:L") instead of the whole sheet and when it finds the search string, copy only the cell value to sheet2 one after the other.

Thanks.

Still too early in California, this macro will copy whatever row in the used range holds a cell where the word entered into the InputBox exists, plus I set ScreenUpdating to True at the beginning of my last macro when it should have been set to False. Brewing my coffee now.

The destination (where these rows are copied to) is Sheet2 starting in row 2.

Stick this macro into a standard module, then go to the worksheet that holds your table of rows to maybe be copied and run the macro, tested OK.

Sub Test2()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub
 
Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True
 
MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

 

[pcdots]

Hi Tom, I found the macro you created for |thursday| on finding value in a cell via inputbox, copy row.... So I tried it out and it worked wonderful. But my question is after you change the:
NextRow = 2

to

NextRow = sheets("Sheet2").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

The message box at the end of the macro, does not seems to work accurate therefore might there be some changes required?
Another question is the macro only find word/s but no number, so is there anyway to search alpha-numeric??

Please help. Thanks in advance

PCDOTS

 

[goosebump815]

Hi Tom,

Your below code was very useful as I am trying to create a macro that is very similar.
My macro requires the user to enter an identifier Eg. Case001 and it will search worksheet "Detail_File" and select all rows that contain 'CASE001' and paste into worksheet "Upload_Det".

However in my worksheet "Upload_Det" Row 1 has a header and I would like what is copied from "Detail_File" to paste from Row 2 without erasing my header.

Can you assist?

Thanks,

Still too early in California, this macro will copy whatever row in the used range holds a cell where the word entered into the InputBox exists, plus I set ScreenUpdating to True at the beginning of my last macro when it should have been set to False. Brewing my coffee now.

The destination (where these rows are copied to) is Sheet2 starting in row 2.

Stick this macro into a standard module, then go to the worksheet that holds your table of rows to maybe be copied and run the macro, tested OK.

Sub Test2()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub
 
Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
NextRow = 2
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True
 
MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

 

[Tom Urtis]

Might this quick adjustment help

Change

For xRow = 1 To LastRow

To
For xRow = 2 To LastRow

And then change the names of your sheets in the code accordingly.
</pre>

 

[goosebump815]

That helps, Thanks

Also, I believe the code is searching the whole sheet for my word - how can I amend the code so that it only search a specific column?

Might this quick adjustment help

Change

For xRow = 1 To LastRow

To
For xRow = 2 To LastRow

And then change the names of your sheets in the code accordingly.

 

[Tom Urtis]

You could use this, if your column of interest, which you did not say, is column C which to Excel is column 3 (if by further example the column was L, you'd replace the 3 with 12):

Sub Test3()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub

Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
NextRow = 2
For xRow = 2 To LastRow
If InStr(Cells(xRow, 3).Value, myWord) > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True

MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

</pre>

 

[91firebird]

Hi Tom,

Your code is awesome! Is there anyway you could tweak it to paste special, values instead of pasting exactly?

Thanks in advance!

You could use this, if your column of interest, which you did not say, is column C which to Excel is column 3 (if by further example the column was L, you'd replace the 3 with 12):

Sub Test3()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub

Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
NextRow = 2
For xRow = 2 To LastRow
If InStr(Cells(xRow, 3).Value, myWord) > 0 Then
Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True

MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

 

[Tom Urtis]

I love these two-fers, where the answer helps others like yourself who did a search, thank you.

You can substitute this line:

Rows(xRow).Copy Sheets("Sheet2").Rows(NextRow)

With this:

Sheets("Sheet2").Rows(NextRow).Value = Rows(xRow).Value


Then, depending on how technically precise you'd like the message box info to be, you can edit the prompt to say the values were copied sans formatting rather than saying the rows were copied. Probably not something anyone using the macro would call you out on, but just putting it out there.


By the way in case anyone reading this is wondering, an AutoFilter method in this case for a single column would be more efficient, I know, but I amended the original macro from the first question asked on this thread that looked at every cell in the used range which I employed a loop for, and I just stayed with the loop approach to demonstrate the amendment of code using a loop for a single column which was asked later.