Looking to Combine Unique Values in Record into Cell with Commas

Posted on 2012-09-17
Last Modified: 2012-09-18
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
Question by:Alex972
    LVL 18

    Accepted Solution


    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


    Author Closing Comment

    Worked great! Thanks

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Suggested Solutions

    PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
    Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
    This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
    This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

    759 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    13 Experts available now in Live!

    Get 1:1 Help Now