Looking to Combine Unique Values in Record into Cell with Commas

Looking for macro to go from individual records to combined records with unique values combined in cell with commas in a new tab.  See ID27862845 where it goes from combined records to individual records in a new tab.

Records Before
Peanut Records Before

Records After
Peanut Records AfterSamplePeanutButterProducts2009-U.xls
Alex CampbellAsked:
Who is Participating?

Try this.

Option Explicit

Sub kTest()
    Dim i   As Long, t, strConcat As String
    Dim ka, k(), n As Long, c As Long
    ka = Worksheets("Before").Range("a1").CurrentRegion.Value2
    ReDim k(1 To UBound(ka, 1), 1 To UBound(ka, 2))
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 2 To UBound(ka, 1)
            If Len(ka(i, 7)) Then 'unique UPC code
                If Not .exists(ka(i, 7)) Then
                    n = n + 1
                    For c = 1 To UBound(ka, 2)
                        k(n, c) = ka(i, c)
                    .Add ka(i, 7), n
                    t = .Item(ka(i, 7))
                    strConcat = k(t, 5) & "," & ka(i, 5)
                    k(t, 5) = strConcat
                End If
            End If
    End With
    If n Then
        With Worksheets("After")
            .Range("a1").Resize(, UBound(k, 2)) = Application.Index(ka, 1, 0)
            .Range("a2").Resize(n, UBound(k, 2)) = k
        End With
    End If
End Sub

Open in new window

Alex CampbellAuthor Commented:
Worked great! Thanks
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.