Merge multiple Rows in one Cell repeatedly in Excel using VBA

Let us assume, you have a list of product and the details of each product are entered in different (3 or more) rows in a sequence. Now, how do you merge all the data in different rows into one single cell, repeatedly? I’ll show you how using a simple macro you can merge 3 or more rows into a single cell with the click of a button, without losing any data.

Merge Multiple Rows in One Cell using VBA

The above image gives an idea about what I am trying explain. It has three different product codes in multiple rows in the first column, followed by product details in the second column (in multiple rows).

The details of each product are entered in different rows. I wish to merge and combine product details (in different rows) into a single cell, for each product.

The Macro

Option Explicit

Private Sub CommandButton1_Click()
    mergeData
End Sub

Sub mergeData()
On Error Resume Next

    Dim cell As Range

    ' get all unique product codes from the first column. (start)
    Dim cUniquePCode As New Collection
    Dim rng As Range
    Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    For Each cell In rng
        cUniquePCode.Add cell.Value, CStr(cell.Value)
    Next
    ' (end)

    Dim mergedText As String
    Dim iRow, iStart, i As Integer
    
    iRow = 2
    iStart = 2
    
    For i = 1 To cUniquePCode.Count         ' for every unique pcode.
        ' extract data to merge.
        For Each cell In Range("B" & iStart & ":B" & Cells(Rows.Count, "B").End(xlUp).Row)
            If Cells(iRow, 1) = cUniquePCode(i) Then
                mergedText = mergedText & cell.Value & " "
                iRow = iRow + 1
            End If
        Next cell

        ' merge data, product code wise.
        With Range("B" & iStart & ":B" & iRow - 1)
            .Clear
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .Merge
            .WrapText = True

            .Value = mergedText          ' add value now, without loosing any data.
        End With
        
        ' also, merge the product code (first column).
        With Range("A" & iStart & ":A" & iRow - 1)
            .Clear
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .Merge
            .WrapText = True

            .Value = cUniquePCode(i)         ' get product code from the collection.
        End With

        mergedText = ""
        iStart = iRow
    Next i
End Sub

Now here’s what I am doing. In the button's click event (its an ActiveX button control), I am calling a procedure named mergeData(). Inside the procedure, I am first extracting all the unique product codes and storing it in a collection.

For Each cell In rng
    cUniquePCode.Add cell.Value, CStr(cell.Value)
Next

Here’s another interesting thing that you have learned today, is how to get all unique values from multiple rows in Excel.

Next, I am running a loop for each unique product code, checking the first column rows for the product code and extracting details from each row in the second column.

For Each cell In Range("B" & iStart & ":B" & Cells(Rows.Count, "B").End(xlUp).Row)
…
Next cell

The repeated product codes in the first column, helps me to extract details in the second column.

Once I have collected all the details, I’ll merge and wrap the data in a single row. I am running the merge and wrap procedure twice, one each for the 2nd column (details), followed by for the 1st row (product code).

' merge data, product code wise.
With Range("B" & iStart & ":B" & iRow - 1)

End With

' also, merge the product code (first column).
With Range("A" & iStart & ":A" & iRow - 1)

End With

Conclusion

It’s a very useful and yet simple procedure to merge multiple rows into a single cell. You can run the macro and get results for 3, 4, 5 and more rows of data, for a specific code (see the above image). Just remember one thing, the product codes must be in the following rows, in a sequence.

← PreviousNext →