I Hope Your Doing Well I Need Support I Have A Data Table See On Botton

I Want This Results

Like First Match Account , Second Match Option Only Have 3 Option always I Like To Array Number

CodePudding user response：

Please, test the next code. It should return as looks to be logical according to your question and comments. It assumes that your picture representing desired output is wrong. It returns in the same sheet starting from "E1". Of course, it may be easily adapted to return anywhere:

Sub TestExtractFruitsPerAccount()
   Dim sh As Worksheet, lastR As Long, arr, arrIt, i As Long 
   Dim arrFin, j As Long, dict As Object

   Set sh = ActiveSheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).Row
   arr = sh.Range("A1:C" & lastR).value
   
   Set dict = CreateObject("Scripting.Dictionary")
   For i = 2 To UBound(arr)
        If Not dict.Exists(arr(i, 1)) Then
            dict.Add arr(i, 1), Array(arr(i, 2) & "|" & arr(i, 3))
        Else
            arrIt = dict(arr(i, 1)): ReDim Preserve arrIt(UBound(arrIt)   1)
            arrIt(UBound(arrIt)) = arr(i, 2) & "|" & arr(i, 3)
            dict(arr(i, 1)) = arrIt
        End If
   Next i

   ReDim arrFin(1 To dict.count, 1 To 4)
   Dim strApp As String, strBan As String, strMng As String
   
   For i = 0 To dict.count - 1
        arrFin(i   1, 1) = dict.Keys()(i)
        arrIt = dict.Items()(i)
        For j = 0 To UBound(arrIt)
            Select Case Split(arrIt(j), "|")(1)
                Case "APPLE"
                    If strApp = "" Then
                        strApp = "Pkt." & Split(arrIt(j), "|")(0)
                    Else
                        strApp = strApp & "," & Split(arrIt(j), "|")(0)
                    End If
                Case "BANANA"
                    If strBan = "" Then
                        strBan = "Pkt." & Split(arrIt(j), "|")(0)
                    Else
                        strBan = strBan & "," & Split(arrIt(j), "|")(0)
                    End If
                Case "MANGO"
                    If strMng = "" Then
                        strMng = "Pkt." & Split(arrIt(j), "|")(0)
                    Else
                        strMng = strMng & "," & Split(arrIt(j), "|")(0)
                    End If
            End Select
        Next j

        If strApp <> "" Then arrFin(i   1, 2) = strApp
        If strBan <> "" Then arrFin(i   1, 3) = strBan
        If strMng <> "" Then arrFin(i   1, 4) = strMng
        strApp = "": strBan = "": strMng = ""
   Next i
   sh.Range("E1").Resize(1, 4).value = Array("Account", "APPLE", "BANANA", "MANGO")
   sh.Range("E2").Resize(dict.count, 4).value = arrFin
End Sub

I took your question as a challenge, even if it is at least strange according to my taste.

Please, test it and send some feedback. Isn't it what you need? If not, please try better describing what you need against what the above code returns.

If something unclear, please do not hesitate to ask for clarifications. I can comment the code lines. I posted it as it is, in order to be sure that you will see it. Your question, as it is, most probably will be deleted...