Concatenate based on other cell data

Dear all,
I am having some data in the CELL range A&B which I use as input data and after processing by macro I want to get the result as output in the range D&E.

CELL A  CELL B
ID	      Value
Apple	1K
Apple	2K
Apple	3K
Mango	8K
Mango	5K
Banana	1k
Lemon	3K
Lemon	4K
Cherry	10k
Cherry	11k
Cherry	12k
Cherry	13k

Here CELL A & CELL B is my input data from this I want to get the results (output) as CELL D and CELL E
Here CELL E will be concatenate value of CELL B

CELL D    CELL E
ID	        Value
Apple	1k,2k,3K
Mango	8K,5K
Banana	1k
Lemon	3k,4k
Cherry	10k,11k,12k,13k

I would use an UDF to perform my activity but it makes my excel halt , I need help to solve my issue by macro or excel formula except UDF. I have attached my excel sheet for better understanding.

You can use a UDF Concat Function and Unique items formula:

Function Concat_Unique(Lookup_Value As String, Lookup_Column As Range, Concat_column As Range)
 
Dim i As Single
Dim Unique As New Collection
Dim Value As Variant
Dim result As String
 
For i = 1 To Lookup_Column.Cells.Rows.Count
    If Lookup_Value = Lookup_Column.Cells(i).Value Then
        If Len(Concat_column.Cells(i)) > 0 Then
            On Error Resume Next
            Unique.Add Concat_column.Cells(i), CStr(Concat_column.Cells(i))
            On Error GoTo 0
        End If
    End If
Next i
 
For Each Value In Unique
    result = result & Value & ", "
Next Value
 
If Len(result) = 0 Then
    Concat_Unique = ""
Else
    Concat_Unique = Left(result, Len(result) - 2)
End If
 
End Function

=IFERROR(INDEX($A$2:$A$13,MATCH(0,INDEX(COUNTIF($D$1:D1,$A$2:$A$13),0,0),0)),"")

UDF Concat funtion form:

=Concat_Unique(D2,$A$2:$A$13,$B$2:$B$13)

EDIT: Forgot to read everything, The UDF part

Hi Special-K , thanks for your nice idea.

Try :-

Sub MG03Apr03
Dim Rng As Range, Dn As Range, Temp As Range, c As Long, nStr As String
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
    If Not Temp Is Nothing Then
        If Not Dn = Temp Then
            c = c + 1
            Cells(c, "D") = Temp.Value: Cells(c, "E") = nStr
            nStr = ""
        End If
    End If
        nStr = nStr & IIf(nStr = "", Dn.Offset(, 1).Value, ", " & Dn.Offset(, 1).Value)
        Set Temp = Dn
Next Dn
c = c + 1
Cells(c, "D") = Temp.Value: Cells(c, "E") = nStr
End Sub

Regards Mick

Hi Mick , your code is working great! It filled my requirements, I appreciated it, it will save my time , thanks for helping me.

Is not my thread, but Mick's code does not work entirely. If you add more data, even if is the same ID, it will create a new line instead of concatenating the values.

Capture.JPG

nur2544:- You're welcome

PaulM100:- The code below will work on your modified data format:-

Sub MG03Apr09
Dim Rng As Range, Dn As Range, n As Long
Set Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn.Offset(, 1).Value
    Else
        .Item(Dn.Value) = .Item(Dn.Value) & ", " & Dn.Offset(, 1).Value
    End If
Next
Range("D1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
End With
End Sub

Regards Mick

Hi PaulM100 , you have written code for helping me , I really appreciated your nice job But earlier I used UDF (I already mention that in my post above) that makes my excel slowness, even some time my whole excel program would gone to halted. What is why I was not interested in UDF. I was disappointed to see your UDF once again although it was working nice. But I was given reputation both of you at the same time.
However, I agree that it was your thread but it was my mistake that not to replay you first, I am sorry for that. I am also agree with you that if I add same id then Mick’s code giving additional id which suppose not to come . this mismatch I didn’t notice that time. Thanks for understanding me.
@ PaulM100 & Mick , I need both of your help to solve my issue.

Hi MickG , Now it works perfectly , thanks once again.