Index/Matching Multiple Line Items on to One Page with Loop - excel

Question

I've got a price list [Data] with up to a thousand multiple items from numerous suppliers. These are output regularly from a database to be sorted (by supplier) for easy updating of pricing and other assorted tasks.
The search criteria are selected from a list box created from the [Data].
This is then to be matched to all the line items in the [Data] and a [Catalogue] created, returning multiple cells from each line. A lot of cells on each row need to be ignored in order to re-enter the system correctly.
I've got it creating a list so far however, the matching starts at the first supplier item and continues to the end of the list, as though it doesn't match the items following after that first initial match.
It needs to pick out only the data from the selected supplier and return the required results.
The raw data is not sorted by supplier, and I am hoping to be able to do this without doing a data sort first. But even with a data sort, it runs to the end of the list.
Private Sub SupplierData_Click()
ListBoxValue = SupplierData.Text
Sheets("Catalogue").Cells(2, 27).Value = ListBoxValue
Unload Me
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim oCell As range
Dim Match As range
Dim i As Long
Dim j As Long
i = 2
j = 0
Set ws1 = ThisWorkbook.Sheets("Catalogue")
Set ws2 = ThisWorkbook.Sheets("Data")
Set Match = ws1.Cells(2, 27)
Do While ws2.Cells(i, 1).Value <> ""
Set oCell = ws2.range("A:A").Find(What:=Match)
If Not oCell Is Nothing Then ws1.Cells(i, 2) = oCell.Offset(j, 0)
If Not oCell Is Nothing Then ws1.Cells(i, 3) = oCell.Offset(j, 1)
If Not oCell Is Nothing Then ws1.Cells(i, 4) = oCell.Offset(j, 9)
i = i + 1
j = j + 1
Loop
End Sub

Answer 1

Solved.
Went a different route.
Private Sub SupplierData_Click()
ListBoxValue = SupplierData.Text
Sheets("Catalogue").Cells(2, 27).Value = ListBoxValue
Unload Me
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim oCell As range
Dim opt3 as range
Set ws1 = ThisWorkbook.Sheets("Catalogue")
Set ws2 = ThisWorkbook.Sheets("Data")
Set opt3 = ws1.Cells(1, 29)
oCell = 2
While Len(ws2.range("A" & CStr(oCell)).Value) > 0
If ws2.Cells(oCell, 1).Value = opt3 Then
ws1.Cells(oCell, 2).Value = ws2.Cells(oCell, 1)
ws1.Cells(oCell, 4).Value = ws2.Cells(oCell, 2) & " " & ws2.Cells(oCell, 8) & " " & ws2.Cells(oCell, 4)
ws1.Cells(oCell, 5).Value = ws2.Cells(oCell, 3)
ws1.Cells(oCell, 6).Value = ws2.Cells(oCell, 10)
oCell = oCell + 1
Wend
End Sub