Tom’s Tutorials For Excel: Concatenating Multiple Items For Unique Partners
Here’s how you can take several associated items that are located in their own cells, and concatenate them as a single string to be housed into one cell.
In the picture, you see Primary Items in column A, which are repeated in each row to accommodate each of their respective Parts Needed. The task is to show each Primary Item only once in column A, with its collective Parts Needed shown in one cell in column B.
Notes (colored green) in the below macro help you to follow the process, including a few tricks:
• Insert a row at each change in value for column A.
• Use those empty rows to identify individual
Areas (blocks of Primary Items).
• Append each set of Parts Needed items with a comma and a space.
• Use the
Range syntax with
Columns to delete a range of columns.
'Declare Long variable for rows; and Range variables for areas and cells.
Dim xRow&, area As Range, cell As Range
'Insert an empty row at each change in Primary Item in column A.
For xRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(xRow, 1).Value <> Cells(xRow - 1, 1).Value Then _
'Insert a column at column A to list unique Primary Item names.
'Open a For...Next loop for each noncontiguous Primary Item area.
For Each area In Columns(2).SpecialCells(2).Areas
'Place a unique Primary Item name from the block of duplicates.
Cells(area.Row, 1).Value = area.Cells(1, 1).Value
'Nest a For...Next loop to join (separated by a commma and a space)
'the "Parts Needed" items into a single cell on the same row as the
'unique Primary Item.
For Each cell In area.Offset(0, 1).Resize(area.Rows.Count, 1)
With Cells(area.Row, 4)
If Len(.Value) > 0 Then
.Value = .Value & ", " & cell.Value
.Value = cell.Value
'Continue and close the nested For...Next loop.
'Continue and close the For...Next areas loop.
'Delete columns B and C which actually were the original data.
'You can do this because inserted column A now lists unique Primary Items.
'Delete rows based on empty cells between unique Primary Items in column A.
'AutoFit the columns to make the final result look more readable.
'Turn on ScreenUpdating.
Application.ScreenUpdating = True