Insert entire row based upon prompted cell value - vba

Question

All, I have the following code, but I need to know how to amend it. I need a prompt or message box that asks me, which value in column A to look for. It should the find the corresponding value in Sheet1 Column A, and copy the Data from Column A to AL over to sheet2.
Here's my code:
Sub MM1()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
lastrow2 = Worksheets("Sheet2").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
For r = lastrow To 2 Step -1
If Range("E" & r).Value = "Yes" Then
Rows(r).Cut Destination:=Worksheets("Sheet2").Range("A" & lastrow2 + 1)
lastrow2 = lastrow2 + 1
Else:
End If
Next r
Application.ScreenUpdating = True
End Sub
Also, this is to be a subset of code which will search for the exact row to insert at.

Answer 1

You don't need to do a manual loop through the rows in sheet1, just use VBA's native Find function. Also You're currently not getting user input, that can be achieved with an InputBox.
See the comments for details about the code.
This example copies the data from the first match:
Sub MM1()
Dim lastrowsheet2 As Long
' Use last cell in UsedRange for its row number,
' if row 1,2,... aren't used, then UsedRange will be shorter than you expect!
With ThisWorkbook.Sheets("Sheet2").UsedRange
lastrowsheet2 = .Cells(.Cells.Count).Row
End With
' Get user input for a search term
Dim userinput As String
userinput = InputBox("Enter a value to search for.", "Column A Search")
' Search for value
Dim findrange As Range
Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").Find(what:=userinput, lookat:=xlWhole, LookIn:=xlValues)
If findrange Is Nothing Then
MsgBox "No matching search results"
Else
lastrowsheet2 = lastrowsheet2 + 1
' Copy values in found row to sheet 2, in new last row
ThisWorkbook.Sheets("Sheet2").Range("A" & lastrowsheet2, "AL" & lastrowsheet2).Value _
= ThisWorkbook.Sheets("Sheet1").Range("A" & findrange.Row, "AL" & findrange.Row).Value
End If
End Sub
This example copies the data from the every match in the column:
Sub MM1()
' Speed improvements
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Use last cell in UsedRange for its row number,
' if row 1,2,... aren't used, then UsedRange will be shorter than you expect!
Dim lastrowsheet2 As Long
With ThisWorkbook.Sheets("Sheet2").UsedRange
lastrowsheet2 = .Cells(.Cells.Count).Row
' If sheet is completely empty, make sure data will be inserted on row 1 not 2
If lastrowsheet2 = 1 And .Cells(1).Value = "" Then lastrowsheet2 = 0
End With
' Get user input for a search term
Dim userinput As String
userinput = InputBox("Enter a value to search for.", "Column A Search")
' Search for value
Dim findrange As Range
Dim firstaddress As String
Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").Find(what:=userinput, lookat:=xlWhole, LookIn:=xlValues)
If findrange Is Nothing Then
MsgBox "No matching search results"
Else
firstaddress = findrange.Address
Do
lastrowsheet2 = lastrowsheet2 + 1
' Copy values in found row to sheet 2, in new last row
ThisWorkbook.Sheets("Sheet2").Range("A" & lastrowsheet2, "AL" & lastrowsheet2).Value _
= ThisWorkbook.Sheets("Sheet1").Range("A" & findrange.Row, "AL" & findrange.Row).Value
' Find next match
Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").FindNext(findrange)
' Loop until the Find has wrapped back around, or value not found any more
Loop While Not findrange Is Nothing And findrange.Address <> firstaddress
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub