Combine text from many cells if adjacent duplicates and macro.

**closerb4** · 01-05-2011, 05:56 PM

I would like to create a function, and subsequently a macro that would solve the following issue:

Column A has IDs with many duplicates. Column B has details for each ID in A. Column B's content is from standardized responses, so for each ID, there may be many responses, and these responses appear repeatedly through Column B.

Example:

Column A | Column B
12345 Cat
12345 Dog
12345 Bird
67890 Cat
67890 Bird

I would like to combine the contents of Column B for each ID into one cell.

Example:

Column A | Column B
12345 Cat, Dog, Bird
67890 Cat, Bird

I understand the function of =B2 & ", " & B3 & ", " & B4, but the trick here is to automate it for hundreds of IDs and thousands of lines such that for instances of duplicates in the ID column A, it runs the formula/script to combine the contents of B into one cell for adjacent to the ID, deleting the duplicate rows containing the IDs and their B data (now combined into one cell in the remaining row for the ID).

Please help, you'd save me literally about 2.5 hours a week for work.

**JBeaucaire** · 01-05-2011, 06:15 PM

Here's a macro for merging rows of data to one row matching for column A.

Columns to Rows - Part 2

This puts the values in the same row, but not the same cell, which might be more useful. Give it a try, there's a sample workbook on that page to help you test it.

**martindwilson** · 01-05-2011, 06:47 PM

And here's an idea to do it with functions but jb's code is far easier!

**closerb4** · 01-05-2011, 07:36 PM

Thank you guys so much! I expected junk...these forums never seem to work out for me. I will try to tack on something else to the macro to combine the contents of the new cells, separated by a comma. Thank you very much! You just saved me about 2 hours a week.

**JBeaucaire** · 01-05-2011, 10:37 PM

Replace this section to make it one cell in column B:

'Group matching names
    For Rw = LastRow To 2 Step -1
        If Cells(Rw, "A").Value = Cells(Rw - 1, "A").Value Then
            Cells(Rw - 1, "B").Value = Cells(Rw - 1, "B").Value & "," & Cells(Rw, "B").Value
            Set delRNG = Union(delRNG, Range("A" & Rw))
        End If
    Next Rw

Also, in that case, you can remove the "Add Titles" section near the end, too.