what if i want more than two columns to show my result

Hello, i found this code a while back and it is exactly what i needed but now i need to add new columns to my search list. how do i make that possible?

I have only been learning for this week and all the arrParts and VBA codes are oh so new. and i havent been able to modify this so i can add a C or D column when my results show.

Please help me. Thank you very much.

Code:

Sub SearchParts()
Dim arrParts() As Variant
Range("A7", "B" & Cells(Rows.CountLarge, "B").End(xlDown).Row).Clear
arrParts = FindParts(CStr(Trim(Cells(2, 2))))
Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
WorksheetFunction.Transpose(arrParts)
End Sub
Private Function FindParts(PartNumber As String) As Variant
Dim ws As Worksheet
Dim FoundCell As Range
Dim LastCell As Range
Dim rngParts As Range
Dim FirstAddr As String
Dim arrPart() As Variant

Set ws = Worksheets("Data")
Set rngParts = ws.Range("B2:C" & ws.Cells(Rows.CountLarge, "B").End(xlUp).Row)

With rngParts
Set LastCell = .Cells(.Cells.Count)
End With

Set FoundCell = rngParts.Find(What:=PartNumber, After:=LastCell, LookAt:=xlPart)

If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If

ReDim arrPart(1 To 2, 1 To 1)
Do Until FoundCell Is Nothing
arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
arrPart(2, UBound(arrPart, 2)) = FoundCell.Value

ReDim Preserve arrPart(1 To 2, 1 To UBound(arrPart, 2) + 1)

Set FoundCell = rngParts.FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
FindParts = arrPart
End Function

fixed it. boy, english is hard.

Sub SearchParts()
Dim arrParts() As Variant
Range("A7", "D" & Cells(Rows.CountLarge, "D").End(xlDown).Row).Clear
arrParts = FindParts(CStr(Trim(Cells(2, 2))))
Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
WorksheetFunction.Transpose(arrParts)
End Sub


and

ReDim arrPart(1 To 4, 1 To 1)
Do Until FoundCell Is Nothing
arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
arrPart(2, UBound(arrPart, 2)) = FoundCell.Value
arrPart(3, UBound(arrPart, 2)) = FoundCell.Offset(0, 1)
arrPart(4, UBound(arrPart, 2)) = FoundCell.Offset(0, 2)

ReDim Preserve arrPart(1 To 4, 1 To UBound(arrPart, 2) + 1)

Set FoundCell = rngParts.FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then


im so happy

fixed it. boy, english is hard.

Sub SearchParts()
Dim arrParts() As Variant
Range("A7", "D" & Cells(Rows.CountLarge, "D").End(xlDown).Row).Clear
arrParts = FindParts(CStr(Trim(Cells(2, 2))))
Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
WorksheetFunction.Transpose(arrParts)
End Sub


and

ReDim arrPart(1 To 4, 1 To 1)
Do Until FoundCell Is Nothing
arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
arrPart(2, UBound(arrPart, 2)) = FoundCell.Value
arrPart(3, UBound(arrPart, 2)) = FoundCell.Offset(0, 1)
arrPart(4, UBound(arrPart, 2)) = FoundCell.Offset(0, 2)

ReDim Preserve arrPart(1 To 4, 1 To UBound(arrPart, 2) + 1)

Set FoundCell = rngParts.FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then


im so happy