copy and search

[arnab07111]

Hi,
I have this excel sheet,where in sheet 1,I have a search option,If I give a 8 digit unique letter in the search option,in the sheet it will search for that item in column D of sheet 2 and if it gets that it will copy that row and paste it in sheet 1 row 5

[Bob Phillips]

Private Sub Search_Click()
Dim lookupVal As String
Dim lookupRow As Long
Dim nextRow As Long
Dim rng As Range

lookupVal = Me.OLEObjects("TextBox1").Object.Text
On Error Resume Next
Set rng = Worksheets("Sheet2").Columns("D").Find(lookupVal)
On Error GoTo 0
If Not rng Is Nothing Then

lookupRow = rng.Row
nextRow = Me.Cells(Me.Rows.Count, "C").End(xlUp).Row + 1
Worksheets("Sheet2").Cells(lookupRow, "B").Copy Me.Cells(nextRow, "C")
Worksheets("Sheet2").Cells(lookupRow, "C").Copy Me.Cells(nextRow, "D")
Worksheets("Sheet2").Cells(lookupRow, "D").Copy Me.Cells(nextRow, "E")
Worksheets("Sheet2").Cells(lookupRow, "E").Copy Me.Cells(nextRow, "F")
Worksheets("Sheet2").Cells(lookupRow, "F").Copy Me.Cells(nextRow, "G")
End If

Set rng = Nothing
End Sub

[arnab07111]

your code only copies the mat given, if there are multiple occurance of mat code in "sheet 2" in that case it doesn't copy the second or third occrence,for example if I give "MW071030" in text box and click on search it will only copy the first occurence in sheet 2 and paste it sheet 1,it won't search for any second or third occurence of the mat code,please advice how to do the same.

[Bob Phillips]

Lookup FindNext in VBA help.

[arnab07111]

I tried the Find next but getting error,please help me in solving the issue

[Bob Phillips]

Post the code you tried, and I will see if I can spot your error.

[arnab07111]

Private Sub Search_Click()
Dim lookupVal As String
Dim lookupRow As Long
Dim nextRow As Long
Dim rng As Range

lookupVal = Me.OLEObjects("TextBox1").Object.Text
On Error Resume Next
Set rng = Worksheets("Sheet2").Columns("D").Find(lookupVal)
On Error GoTo 0
If Not rng Is Nothing Then

lookupRow = rng.Row
nextRow = Me.Cells(Me.Rows.Count, "C").End(xlUp).Row + 1
Worksheets("Sheet2").Cells(lookupRow, "B").Copy Me.Cells(nextRow, "C")
Worksheets("Sheet2").Cells(lookupRow, "C").Copy Me.Cells(nextRow, "D")
Worksheets("Sheet2").Cells(lookupRow, "D").Copy Me.Cells(nextRow, "E")
Worksheets("Sheet2").Cells(lookupRow, "E").Copy Me.Cells(nextRow, "F")
Worksheets("Sheet2").Cells(lookupRow, "F").Copy Me.Cells(nextRow, "G")
End If

Set rng = Nothing
.FindNext rng
End Sub

[Bob Phillips]

Oh come on. If you really looked at FindNext in VBA help, and if you really tried to implement it, you wouldn't have shoved that weak effort under my nose. WE are not your private coder serfs, if you aren't willing to even try to help yourself, you don't deserve to succeed.

[arnab07111]

but where is VBA help,I tried by myself

[arnab07111]

I am still awaiting the answer

[mohanvijay]

Hai try this code it will display 500 times occurence

and i have attached solved excel file

Private Sub Search_Click()

Dim holdwms(1 To 500), holdpall(1 To 500), holddes(1 To 500), holdqty(1 To 500) As Variant
Dim repeat, x As Integer
repeat = 1
x = 0

mat_value = Me.OLEObjects("TextBox1").Object.Value

For i = 1 To 5000

match_mat = Sheets(2).Cells(3 + i, 4).Value
If mat_value = match_mat Then
holdwms(repeat) = Sheets(2).Cells(3 + i, 2).Value
holdpall(repeat) = Sheets(2).Cells(3 + i, 3).Value
holddes(repeat) = Sheets(2).Cells(3 + i, 5).Value
holdqty(repeat) = Sheets(2).Cells(3 + i, 6).Value

repeat = repeat + 1
x = 1

End If

Next i

If x = 0 Then
MsgBox "NO MATCH"
Exit Sub
End If

For ii = 1 To repeat - 1
Cells(4 + ii, 3).Value = holdwms(ii)
Cells(4 + ii, 4).Value = holdpall(ii)
Cells(4 + ii, 5).Value = mat_value
Cells(4 + ii, 6).Value = holddes(ii)
Cells(4 + ii, 7).Value = holdqty(ii)
Next ii

End Sub

[gcomyn]

for VBA help, you need to be in the VBIDE (looking at the code) then hit F1, or go to the Help menu....

GComyn
:sleuth: