search and display row on same sheet

[DarReNz]

Hi,

I am wondering how am I able to key in an input(input worksheet) and when i hit enter it searches another worksheet(data worksheet) for the result and outputs the entire row on input worksheet. Anyone can help ? Thanks

Input worksheet

Search: 12345


Name Number Address
alan 12345 cyber

[Killian]

You can use the Find to search the data worksheet and copy the result. You can specify a destination with the copy method - your input sheet.
Here's a simple example - I've just used row 1 for the destination...Dim num As String
Dim r As Range

num = InputBox("Enter Number to find:")
If num <> "" Then
Set r = Sheets("data").Columns(2).Find(num, LookIn:=xlValues)
If Not r Is Nothing Then
Sheets("data").Rows(r.Row).Copy Destination:=Sheets("input").Rows(1)
End If
End If

[DarReNz]

hi killian,

the above only checks for one input value if there is a few rows that have the same input it does not copy it over. how do i do this ?

[jindon]

something like this..

Sub test()
Dim r As Range, ff As String, num
num = InputBox("Enter number")
With Sheets("data").Range("a:d")
Set r = .Columns(3).Find(num, , , xlWhole)
If Not r Is Nothing Then
ff = r.Address
Do
i = i + 1
Sheets("input").Cells(i + 6, "a").Resize(, 4) = r.EntireRow.Value
Set r = .Columns(3).FindNext(r)
Loop Until ff = r.Address
Else
MsgBox "Not Found"
End If
End With
End Sub

[DarReNz]

hi jindon,

I don't quite get it. I am attaching a file. As you can see when i enter number 222 into D3, 2 rows should appear. any help ?

[jindon]

code has been edited

do you want to copy it again and try?

[DarReNz]

hi jindon,

you didn't upload the edited copy .....

[jindon]

I updated the code that I have posted previously..

[DarReNz]

jindon,

the excel application hangs after i edit to


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim r As Range, ff As String, num
num = Range("D3").Value
With Sheets("data").Range("a:d")
Set r = .Columns(3).Find(num, , , xlWhole)
If Not r Is Nothing Then
ff = r.Address
Do
i = i + 1
Sheets("input").Cells(i + 6, "a").Resize(, 4) = r.EntireRow.Value
Set r = .Columns(3).FindNext(r)
Loop Until ff = r.Address
Else
MsgBox "Not Found"
End If
End With
End Sub

[jindon]

Did you call me?

You should be very quick, if you want some help from me.
I'll go off-line in 20 min...
otherwise tomorrow.

[DarReNz]

yes still having some problems .... how to fix this ?

[jindon]

Where did you place the code?
you may need to set enableevents to False at the begining...

and set it back to True at the end...

if you post the file with your code, I can look at it.

[DarReNz]

here is the file jindon .....

[Killian]

Hi again,

I made the change to look for multiple entrie to my original post and added a function to find the next available row - seems to workPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim num As String
Dim r As Range
Dim firstAddress As String

num = InputBox("Enter Number to find:")
If num <> "" Then
Set r = Sheets("data").Columns(2).Find(num, LookIn:=xlValues, lookAt:=xlWhole)
If Not r Is Nothing Then
firstAddress = r.Address
Do
Sheets("data").Rows(r.Row).Copy Destination:=Sheets("input").Rows(TargetRow(Sheets("input")))
Set r = Sheets("data").Columns(2).FindNext(r)
Loop While Not r Is Nothing And r.Address <> firstAddress
End If
End If

End Sub

Function TargetRow(ws As Worksheet) As Long
'function to return the row index of the first empty row
Dim lngLastRow As Long
lngLastRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(ws.Cells(lngLastRow, 2)) Then
TargetRow = 1
Else
TargetRow = lngLastRow + 1
End If
End Function

[jindon]

I just set the Find method with xlPart, which look up partial match
e.g. if you enter 1, it will find either 11, 001, 111, 234561, 1000...etc
if you don't want it, just set back to xlWhole...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, ff As String, num
num = Range("D3").Value
With Sheets("data").Range("a:d")
Set r = .Columns(3).Find(num, , , xlPart) '<- change to xlWhole if you need
If Not r Is Nothing Then
Application.EnableEvents = False
With Range("a5").CurrentRegion
If .Rows.Count > 1 Then _
.Offset(1).Resize(.Rows.Count - 1).ClearContents
End With
ff = r.Address
Do
i = i + 1
Sheets("input").Cells(i + 5, "a").Resize(, 4) = r.EntireRow.Value
Set r = .Columns(3).FindNext(r)
Loop Until ff = r.Address
Else
MsgBox "Not Found"
End If
Application.EnableEvents = True
End With
End Sub