Excel Search Function - Help

Hi there,

I am wokring on adapting a VBA someone else wrote to apply it to my excel workbook.
So far I have it working to display the results of all the feilds that match the text with "C6" or (6,3).

Here is the code:

Sub SearchParts()
 Dim arrParts() As Variant
    Range("C24", "D" & Cells(Rows.CountLarge, "D").End(xlDown).Row).clear
    arrParts = FindParts(CStr(Trim(Cells(6, 3))))
    Range("C24").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("EA")
    Set rngParts = ws.Range("AK2:AK" & ws.Cells(Rows.CountLarge, "AK").End(xlUp).Row)

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

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

    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

So all the cells within worksheet "EA" within range of AK2: AK(however many rows I have) are displayed in Cell D24 and down. (I just blatantly copied this from someone else and tweaked a few values to fit my spreadsheet).

The results that match are pasted in D24 (and down) and the value in the cell to the immediate right of the matched (i.e. if AK2 in EA matched C6 in my search worksheet, then AL2 is the one to the immediate right) is pasted into the worksheet in C24 (one position to the left). Opposite direction...

Im guessing it is something to do with:

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

What I would like is almost there... but I do not know how to tweak it.

How would I be able to make the value matched to be pasted in to C24 and then the next 6 cells to the right of the matched cell (e.g. AK2 in "EA" worksheet) to be pasted in to D24,E24,F24,G24,H24,I24 respectively?

The original spreadsheet that I copied this from is attached.

p.s. My worksheet has 470000 rows and 140 coloumns and every 2nd or 3rd time I open the document and run this macro it says that it is out of memory and cannot perform the function... (if any one has hints on helping excel deal with larger amounts of data let me know...but this is less improtant as I can easily split this data up later).

p.p.s. If anyone has a good tutorial series on youtube or a few books they would recomend to learning how to deal with Search Arrays (or whatever you call these types of VBAs) in Excel VBA and learn all these terms such as UBound, (1 to 2), reDim etc.... I would also appreciate it...Ideally I would like to give back one day to this forum and help others