An Excel code to search data from command button - excel

Question

I have tried to make a button which searches through a selection of data on one sheet for a ID number then returns the corresponding data in the row after onto a different sheet. I thought i had it sorted but this just wont work and have run out ideas.
Any help would be appreciated.
see code below:
Private Sub CommandButton2_Click()
Dim Userentry As String
Dim DataRange As Range
Dim i As Long
Dim location As Integer
Dim ws, ws1 As Worksheet
Set ws = Sheets("Sheet1")
Set ws1 = Sheets("Sheet4")
With TextBox2
Userentry = .Value
End With
Range("A36").Value = Userentry
For i = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
If LCase(Cells(i, 1).Value) = Userentry Then ws1.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = Cells(i, 2).Value
Next i
For i = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
If LCase(Cells(i, 1).Value) = Userentry Then ws1.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = Cells(i, 3).Value
Next i
For i = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
If LCase(Cells(i, 1).Value) = Userentry Then ws1.Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Value = Cells(i, 4).Value
Next i
For i = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
If LCase(Cells(i, 1).Value) = Userentry Then ws1.Range("I" & Rows.Count).End(xlUp).Offset(1, 0).Value = Cells(i, 5).Value
Next i
End Sub

Answer 1

I'd throw in two possible solutions, with the goal to minimize execution time (should it be an issue)
solution 1
here you're still actually looping through column A cells but:
only if there's at least one matching value
considering non empty cells with text values only
`
Option Explicit
Private Sub CommandButton2_Click()
Dim Userentry As String, firstAddr As String
Dim ws1 As Worksheet
Dim f As Range
Set ws1 = Sheets("Sheet4")
Userentry = TextBox2.Value
ws1.Range("A36").Value = Userentry
With Sheets("Sheet1")
With .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)'<~~ consider column "A" cells with text values down to the LAST non empty one
Set f = .Find(What:=Userentry, LookAt:=xlWhole, LookIn:=xlValues)
If Not f Is Nothing Then '<~~ loop only if there's at least one matching value
firstAddr = f.Address
Do
ws1.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 4).Value = _
f.Offset(, 1).Resize(1, 4).Value
Set f = .FindNext(f)
Loop While f.Address <> firstAddr
End If
End With
End With
End Sub
`
solution 2
this avoids looping at all, but at the "expense" of sorting rows
Option Explicit
Private Sub CommandButton2_Click()
Dim Userentry As String
Dim countVal As Long
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet4")
Userentry = TextBox2.Value
ws1.Range("A36").Value = Userentry
With Sheets("Sheet1")
With .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ consider column "A" cells down to the LAST non empty one
countVal = Application.WorksheetFunction.CountIf(.Cells, Userentry) '<~~ count matching values
If countVal > 0 Then '<~~ if any then ...
.Resize(, 5).Sort key1:=.Range("A1"), order1:=xlDescending, Header:=xlNo '<~~ ... sort columns "A" to "E" by column "A" values...
ws1.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Resize(countVal, 4).Value = .Find(What:=Userentry, LookAt:=xlWhole, LookIn:=xlValues).Offset(, 1).Resize(countVal, 4).Value '<~~ ... and copy/paste values
End If
End With
End With
End Sub
if you should ever mind having Sheet1 rows sorted, then here's the "patch"
Private Sub CommandButton2_Click()
Dim Userentry As String
Dim countVal As Long
Dim ws1 As Worksheet
Dim helperCol As Range
Set ws1 = Sheets("Sheet4")
Userentry = TextBox2.Value
ws1.Range("A36").Value = Userentry
With Sheets("Sheet1")
Set helperCol = .UsedRange.Columns(.UsedRange.Columns.Count + 1) '<~~ set a helper column "out of the town" not to interfere with data already there
With .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ consider column "A" cells down to the LAST non empty one
countVal = Application.WorksheetFunction.CountIf(.Cells, Userentry) '<~~ count matching values
If countVal > 0 Then '<~~ if any then ...
With Intersect(.Rows.EntireRow, helperCol) '<~~ consider helper column rows corresponding to your data ones
.Formula = "=ROW()" '<~~ place an ascending index to every row
.Value = .Value '<~~ get rid of formulas, otherwise subsequent sorting would have no effect on their result
End With
.Resize(, helperCol.Column).Sort key1:=.Range("A1"), order1:=xlDescending, Header:=xlNo '<~~ ... sort columns "A" to "helpercol" rows by column "A" values...
ws1.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Resize(countVal, 4).Value = .Find(What:=Userentry, LookAt:=xlWhole, LookIn:=xlValues).Offset(, 1).Resize(countVal, 4).Value '<~~ ... copy/paste values ...
.Resize(, helperCol.Column).Sort key1:=helperCol, order1:=xlAscending, Header:=xlNo '<~~ ... and sort columns "A" to "helpercol" rows back by "helpercol" values
helperCol.Clear '<~~ finally clear "helpercol" column
End If
End With
End With
End Sub

Answer 2

Private Sub CommandButton2_Click()
Dim Userentry As String
Dim i As Long
Dim ws, ws1 As Worksheet
Set ws = Sheets("Sheet1")
Set ws1 = Sheets("Sheet4")
Userentry = TextBox2.Value
ws1.Range("A36").Value = Userentry
For i = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
If LCase(ws.Cells(i, 1).Value) = Userentry Then
ws1.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 4).Value = _
ws.Cells(i, 2).resize(1, 4).Value
End If
Next i
End Sub