Concatenate based on duplicate cells in different rows.

[pjmthissen]

Hi folks,

I have i list that shows in column A the title and in column B the topic.
This list is generated by an external system and unfortunately that system generates a new row in case a title has multiple topics.
I want generate list that has no duplicate titles and shows the topics concatenated in case a there are multiple topics per title.

In case I manage to get something like the below example I can use the remove duplicates functionality to get a list without duplicate titles.
Or is it possible to do both; concatenate the topic and remove a duplicate row in one go?

An example:
[TABLE="width: 785"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Title[/TD]
[TD]Topic[/TD]
[TD]Concatenated topics[/TD]
[/TR]
[TR]
[TD]CRD / Light Production Business – REFRESH[/TD]
[TD]S&M - DS[/TD]
[TD]S&M - DS; S&M - BIS[/TD]
[/TR]
[TR]
[TD]CRD / Light Production Business – REFRESH[/TD]
[TD]S&M - BIS[/TD]
[TD]S&M - DS; S&M - BIS[/TD]
[/TR]
[TR]
[TD]Purchase to Pay Curriculum[/TD]
[TD]S&M - DS[/TD]
[TD]S&M - DS[/TD]
[/TR]
[TR]
[TD]DS Managed Services Training Presales[/TD]
[TD]S&M - DS[/TD]
[TD]S&M - DS[/TD]
[/TR]
[TR]
[TD]Negotiation and Closing of Business Cases[/TD]
[TD]S&M - DS[/TD]
[TD]S&M - DS; S&M - SB&S; S&M - IPS[/TD]
[/TR]
[TR]
[TD]Negotiation and Closing of Business Cases[/TD]
[TD]S&M - SB&S[/TD]
[TD]S&M - DS; S&M - SB&S; S&M - IPS[/TD]
[/TR]
[TR]
[TD]Negotiation and Closing of Business Cases[/TD]
[TD]S&M - IPS[/TD]
[TD]S&M - DS; S&M - SB&S; S&M - IPS[/TD]
[/TR]
[TR]
[TD]Advanced economics - deepen accounting fundamentals[/TD]
[TD]S&M - DS[/TD]
[TD]S&M - DS; S&M - LFP[/TD]
[/TR]
[TR]
[TD]Advanced economics - deepen accounting fundamentals[/TD]
[TD]S&M - LFP[/TD]
[TD]S&M - DS; S&M - LFP[/TD]
[/TR]
</tbody>[/TABLE]


Thanks in advance.

 

[Fluff]

Hi & welcome to the board
How about

Sub ConcatCopy()

   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = ActiveSheet
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & "; " & Cl.Offset(, 1).Value
         End If
      Next Cl
      Sheets.Add(, Sheets(Sheets.Count)).Name = "New"
      Sheets("New").Range("A1").Value = "Title"
      Sheets("New").Range("B1").Value = "Concatenated topics"
      Sheets("New").Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
      Sheets("New").Range("B2").Resize(.Count).Value = Application.Transpose(.items)
   End With
End Sub

 

[pjmthissen]

Unfortunately the code does not help me (it does not work in my spreadsheet). The only thing it does is creating a new worksheet named "New". Nothing is concatenated/copied to the new sheet.

 

[Fluff]

Was the sheet with your data the active sheet when you ran the macro?
Also is your data in cols A & B, starting with a header in row 1 & data in row 2?

 

[pjmthissen]

Yes it was the active sheet.
Also the sheet has headers in row 1.
Data starts in row 2 in column A and B.

 

[pjmthissen]

Tried again form scratch and now it works. TOP!!!
Thank a lot.

 

[Fluff]

Glad to help & thanks for the feedback