conditionally concatenate text from multiple records in vba [duplicate]

This question already has an answer here: conditionally concatenate text from multiple records in vba (1 answer) Closed 8 years ago.

UniqueID Description            ConsolidatedText   
Str1     Here is a sentence     Here is a sentence 
Str2     And another sentence.  And another sentence. And some words                       
Str2     And some words         
Str3     123                    123
Str4     abc                    abc ###
Str4     ###                    

OK - I'll try that again. Ignore previous post with identical title and unformatted code!!

I have a number o开发者_如何转开发f records (~4000) each with a UniqueID value (text) and a text field (potentially quite lengthy) which is a user-entered description of the data. I need to consolidate the spreadsheet by concatenating all the descriptions into a single record where there are multiple occurrences of the UniqueID value. Generically, I want to loop through the range of potential values and say "if UniqueID is equal, then take all of the Description values and concatenate them together in a single row (either the first row or a new row) then delete all the old rows." Basically, I want to create the ConsolidatedText field in this sample data, and then also delete the extra rows. This is beyond my VBA programming abilities, and any help with the structure of this macro would be greatly appreciated.

---

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

---

If you don't want to do vba (if this is just for one shot), here is what you can do:

1. Add the column "ConsolidatedText"
2. Sort your values by UniqueID
3. Create a formula in "ConsolidatedText" (first one in C2 and drag and drop the formula till the end): =IF(A2=A3;B2&" "&B3;IF(A2=A1;"dupplicate";B2))
4. Filter the "dupplicate" values of ConsolidatedText and delete all these rows

I let you adapt the formula if you have more than 2 identical ids.