Concatenating Solution

[jhumphrey22]

Hello,

I have an issue whereby there are two columns of data that I need to essentially "roll-up". The first column is a list of IDs, and the second column is a list of names. The names listed are duplicated and are assigned to multiple IDs. The end goal is to have a new tab in an excel workbook that would now list the name in column A, and in column B show the IDs associated with that name separated by ", ". The idea is to have two views, one by ID with the corresponding names, and one by Name, with the IDs concatenated in the concurrent column.

This needs to be able to adapt to a varying numbers of rows, IDs and names. Can somebody help with this? At this point, we have to create a pivot table, find the IDs listed for each name, and then concatenate the IDs separated by ", ". It takes forever, as you can imagine.

Below is a sample file:
[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]AS1234[/TD]
[TD]John Smith[/TD]
[/TR]
[TR]
[TD]AD1234[/TD]
[TD]Joe West[/TD]
[/TR]
[TR]
[TD]AF1234[/TD]
[TD]John Smith[/TD]
[/TR]
[TR]
[TD]AG1234[/TD]
[TD]Joe West[/TD]
[/TR]
[TR]
[TD]AK1234[/TD]
[TD]John Smith[/TD]
[/TR]
[TR]
[TD]AG1234[/TD]
[TD]Joe West[/TD]
[/TR]
[TR]
[TD]AR1234[/TD]
[TD]John Smith[/TD]
[/TR]
</tbody>[/TABLE]


Please help!!

Thanks,
JH

 

[mole999]

how about =B2 & "," & A2

 

[circledchicken]

Hi and welcome to the forum,

Just out of interest, why do you need to concatenate the ID's?
Your PivotTable approach seems to make sense to me, and offers a nice/simple/filterable view of the IDs grouped by name?

Anyway, here is a procedure you can try (try it on a copy of your data):

Sub example()


    Dim vArr    As Variant
    Dim vOut    As Variant
    Dim v       As Variant
    Dim dict    As Object
    Dim i       As Long
    Dim j       As Long
    
    ' assign range to array
    vArr = Range("A1").CurrentRegion.Value2
    
    ' initialise dictionary
    Set dict = CreateObject("scripting.dictionary")
        
    With dict
        ' store distinct name values
        For i = 2 To UBound(vArr, 1)
            If Not .Exists(vArr(i, 2)) Then
                .Add Key:=vArr(i, 2), Item:=vArr(i, 1)
            Else
                .Item(vArr(i, 2)) = .Item(vArr(i, 2)) & ", " & vArr(i, 1)
            End If
        Next i
        
        ' populate output array
        ReDim vOut(1 To .Count, 1 To 2)
        For Each v In dict
            j = j + 1
            vOut(j, 1) = v
            vOut(j, 2) = .Item(v)
        Next v
    End With
    
    ' print column headers
    With Sheets("Sheet1").Range("D1")
        .Resize(1, 2).Value2 = Array("Name", "Concatenated IDs")
        .Resize(1, 2).Font.Bold = True
    End With
    
    ' print output array
    Sheets("Sheet1").Range("D2").Resize(UBound(vOut, 1), _
                                        UBound(vOut, 2)).Value2 = vOut


End Sub

This assumes your data table begins in A1 of Sheet1, and prints the output starting from D1 of Sheet1 (you can change the input and output ranges as required).