comparing serial #s against another sheet then only displaying only the matching items and all assoc

[nicktrit]

Hi All
I have been trying to work out how to take the serial numbers from,
say, worksheet1, compare those serial numbers to those taken from a
database in worksheet2. Then only displaying the matching serial
numbers and ALL associated data with that serial number from WS2, on
worksheet3.

I have a barcode reader which I use for auditing my equipment. It
collects the asset serial numbers and I would like to speed up the
comparison to the database.

I have some code, its says I have matches but its doesn't display the
results on worksheet3.

Any help and guidance would be greatly appreciated.

Thanks in advance



The code is as follows:-

Sub SearchandCopy()

' This macro is used to loop through a column - specfied by the
"ColumnVar" variable - of values, in "Sheet2". Searching for a
' matching value in any of the rest of Sheet2. If it finds a match it
copies the row to Sheet3, starting at column A to
' column number x specified by ".Cells(x, 5). Assuming row 3, would
copy cells A3:E3.

Dim reference_value As Variant
Dim lastrow_lookup As Long, x As Long, ColumnArray(100) As String, intI
As Integer, ColumnVar As String

For intI = 1 To 30
ColumnVar = "R" & intI
ColumnArray(intI) = ColumnVar
Debug.Print ColumnArray(intI)
Next

For intI = 1 To 30
With ThisWorkbook.Sheets("Sheet2")
reference_value = .Range(ColumnArray(intI))
lastrow_lookup = .Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print reference_value
End With

For x = 1 To lastrow_lookup
If Sheets("Sheet2").Cells(x, 1) = reference_value Then
Debug.Print "match"
Sheets("Sheet2").Range(Sheets("Sheet2").Cells(x, 1),
Sheets("Sheet2").Cells(x, 9)).Copy
Sheets("Sheet3").Cells(Sheets("Sheet3").Cells(Rows.Count,
1).End(xlUp).Row + 1, 1)
End If
Next x
Next
End Sub

 

[Graham Whitehead]

Something like this is what you need. Taylor it to suit your specific
needs. If you need a hand just reply back.

Sub test()

Dim arrWK1(70) As Long
Dim arrWK2(70) As Long
Dim x As Integer, y As Integer, counter As Integer

counter = 1

For x = 1 To 70
arrWK1(x) = Sheet1.Cells(x, 1).Value
For y = 1 To 70
arrWK2(y) = Sheet2.Cells(y, 1).Value
If arrWK1(x) = arrWK2(y) Then
Sheet3.Cells(counter, 1).Value = arrWK1(x)
counter = counter + 1
End If
Next y
Next x

End Sub