[Solved] conditionally concatenate text from multiple records in vba [duplicate]

by


Try the below code, it assumes you have headers and that unique ID is in column A and description in column B.

Option Explicit
Sub HTH()
    Dim vData As Variant
    Dim lLoop As Long
    Dim strID As String, strDesc As String

    '// Original data sheet, change codename to suit
    vData = Sheet1.UsedRange.Value

    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1

        For lLoop = 1 To UBound(vData, 1)
            strID = vData(lLoop, 1):strDesc = vData(lLoop, 2)

            If Not .exists(strID) Then
                .Add strID, strDesc
            Else
               .Item(strID) = .Item(strID) & " " & strDesc
            End If
        Next

       '// Data output, change sheet codename to suit
        Sheet2.Range("a1").Resize(.Count).Value = Application.Transpose(.keys)
        Sheet2.Range("b1").Resize(.Count).Value = Application.Transpose(.items)
    End With

End Sub

EDIT

If you want to erase and overwrite the original data then try:

Option Explicit
Sub HTH()
    Dim vData As Variant
    Dim lLoop As Long
    Dim strID As String, strDesc As String

    '// Change all references of activesheet to your worksheet codename.

    With ActiveSheet.UsedRange
        vData = .Value
        .Clear
    End With

    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1

        For lLoop = 1 To UBound(vData, 1)
            strID = vData(lLoop, 1):strDesc = vData(lLoop, 2)

            If Not .exists(strID) Then
                .Add strID, strDesc
            Else
               .Item(strID) = .Item(strID) & " " & strDesc
            End If
        Next

       '// Data output, change sheet codename to suit
        ActiveSheet.Range("a1").Resize(.Count).Value = Application.Transpose(.keys)
        ActiveSheet.Range("b1").Resize(.Count).Value = Application.Transpose(.items)
    End With

End Sub

5

solved conditionally concatenate text from multiple records in vba [duplicate]