(Excel) How can I AUTOMATE the creation of a comma separated list?

Question

I will admit that Excel is far from my strength, so any help would be appreciated.

We have a large pull of data in an excel spreadsheet (~15,000 lines) that needs to be reported against.

For each item in Column A, there are one or more values in Column B.

The table below depicts what I mean, albeit at a VERY small scale:

Is there a way to have Excel run through such a table, and for each unique value in Column A, compile a comma separated list for every corresponding value in Column B.

i.e.

Thanks for your help in advance.

Answer 1

This is for andy:

use the array formula:

=TEXTJOIN(",",TRUE,IF(A1:A7="andy",B1:B7,""))

Array formulas must be entered with Ctrl + Shift + Enter rather than just the Enter key. If this is done correctly, the formula will appear with curly braces around it in the Formula Bar.

Repeat the formula for each unique name.

EDIT#1:

To automate this:

1. copy column A to column C
2. use Excel's RemoveDuplicates feature to create a list of unique names
3. apply the array formula to each member of that unique list.

EDIT#2:

To automate with VBA, run this short macro:

Sub PleaseAutomate()
        Dim N As Long
        Dim M As Long

        M = Cells(Rows.Count, "A").End(xlUp).Row
        Columns(1).Copy Columns(3)
        Columns(3).RemoveDuplicates Columns:=1, Header:=xlNo
        N = Cells(Rows.Count, "C").End(xlUp).Row
        Range("D1").FormulaArray = "=TEXTJOIN("","",TRUE,IF($A$1:$A$" & M & "=C1,$B$1:$B$" & M & ",""""))"
        Range("D1").Copy Range("D2:D" & N)
End Sub

Answer 2

This will handle your entire data set. Have a look at the comments and update your ranges in the two places it specifies. To be honest though where's your data pulled from? I'm assuming a database. You should probably handle this in your data feed instead

Public Sub ValuestoStringSeparated()
    Dim Data As Variant, Results As Variant, tmp As Variant
    Dim Dict As Object
    Dim i As Long
    Dim Key

    Set Dict = CreateObject("Scripting.Dictionary")

    ' Update this to your sheet Ref
    With ActiveSheet
        Data = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)).Value2
    End With

    ' Add your raw data to Dictionary
    For i = LBound(Data, 1) To UBound(Data, 1)
        If Not Dict.Exists(Data(i, 1)) Then
            ReDim tmp(0)
            tmp(0) = Data(i, 2)
            Dict.Add Key:=Data(i, 1), Item:=tmp
        Else
            tmp = Dict(Data(i, 1))
            ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
            tmp(UBound(tmp)) = Data(i, 2)
            Dict(Data(i, 1)) = tmp
        End If
        Erase tmp
    Next i

    ' Print your Data to sheet
    ReDim Results(1 To Dict.Count, 1 To 2)
    i = 0
    For Each Key In Dict.keys
        i = i + 1
        Results(i, 1) = Key
        Results(i, 2) = Join(Dict(Key), ", ")
    Next Key

    ' Update with your desired output destination
    With ActiveSheet.Range("D2")
        .Resize(UBound(Results, 1), UBound(Results, 2)).Value2 = Results
    End With
End Sub

Answer 3

Approach via dictionary and datafield array

Similar to the @Tom 's good solution above :+), but joining insurance types already in dictionary and avoiding a constant ReDim Preserve of an additional tmp array. Note: I decided to use counters instead of the correct LBound and UBound counts for better readability, thus allowing an easy range definition, too.

Code

Option Explicit
Sub JoinTypes()
  Const DELI As String = ","
  Dim dict As Object, d
  Dim i    As Long, n As Long
  Dim sKey As String
  Dim v    As Variant, Results() As Variant
  Dim ws   As Worksheet
  Set ws = ThisWorkbook.Worksheets("Test")            ' << change to your sheet name
  Set dict = CreateObject("Scripting.Dictionary")     ' dictionary object

' [1] get last row in column A
  n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
' [2] read data into 1-based 2-dim datafield array
  v = ws.Range("A1:B" & n)
' [3] get Customers and collect joined values into dictionary (omit title row)
  For i = 2 To n
      sKey = v(i, 1)
      If dict.Exists(sKey) Then                 ' join insurance types (delimiter ",")
         dict(sKey) = dict(sKey) & DELI & v(i, 2)
      Else                                      ' start new customer
         dict.Add key:=sKey, Item:=v(i, 2)
      End If
  Next i
  Erase v
' [4] write joined values into new array
   n = dict.Count                               ' redefine counter
   ReDim Results(1 To n, 1 To 2)                ' redimension new array ONLY ONCE :-)
   i = 0
   For Each d In dict.keys                      ' loop through customers in dictionary keys
       i = i + 1: Results(i, 1) = d: Results(i, 2) = dict(d)
   Next d
 ' [5] write array back to sheet (e.g. column D:E omitting title row)
   ws.Range("D2:E" & n + 1) = Results
 ' [6] clear memory
   Set ws = Nothing: Set dict = Nothing
End Sub