Aggregate, Collate and Transpose rows into columns

You cannot concatenate a range of cells (aka Letters) using native worksheet functions without knowing the scope beforehand. As your collection of strings into groups has random numbers of elements, a VBA loop approach seems the best (if not the only) way to address the issue. The loop can make determinations along the way that a worksheet function is simply incapable of performing.

Tap Alt+F11 and when the Visual Basic Editor (aka VBE) opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste one or both of the following into the new pane titled something like Book1 – Module1 (Code).

To concatenate the string groups delimited by a space:

Sub concatenate_and_transpose_to_delim_string()
    Dim rw As Long, lr As Long, pid As Long, str As String
    Dim bPutInColumns As Boolean

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).row
        .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters")
        pid = .Cells(2, 1).Value
        For rw = 2 To lr
            If IsEmpty(.Cells(rw, 1)) Then
                str = str & Chr(32)
                If pid <> .Cells(rw + 1, 1).Value Then
                    .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid
                    .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str
                End If
            ElseIf pid <> .Cells(rw, 1).Value Then
                pid = .Cells(rw, 1).Value
                str = .Cells(rw, 2).Value
            Else
                str = str & .Cells(rw, 2).Value
            End If
        Next rw
        .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid
        .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str
    End With
End Sub

To split the string groups into columns:

Sub concatenate_and_transpose_into_columns()
    Dim rw As Long, lr As Long, nr As Long, pid As Long, str As String

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).row
        .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters")
        For rw = 2 To lr
            If IsEmpty(.Cells(rw, 1)) Then
                .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str
                str = vbNullString
            ElseIf pid <> .Cells(rw, 1).Value Then
                pid = .Cells(rw, 1).Value
                nr = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).row
                .Cells(nr, 4) = pid
                str = .Cells(rw, 2).Value
            Else
                str = str & .Cells(rw, 2).Value
            End If
        Next rw
        .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str
    End With
End Sub

Tap Alt+Q to return to your worksheet. With your sample data on the active worksheet starting with Id in A1, tap Alt+F8 to open the Macros dialog and Run the macro.

Results from concatenate_and_transpose_to_delim_string:

    Concatenate and Transpose to delim strang

Results from concatenate_and_transpose_into_columns:

    Concatenate and Transpose

The results will be written into the cells starting at D2. Probably best if there was nothing important there beforehand that would be overwritten.

Addendum:

I original misinterpreted your request and split the string groups into separate columns. I’ve rectified that with a supplemental routine that more closely follows your description of requirements but kept both variations for others to reference.

Leave a Comment