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:

Title	Topic	Concatenated topics
CRD / Light Production Business – REFRESH	S&M - DS	S&M - DS; S&M - BIS
CRD / Light Production Business – REFRESH	S&M - BIS	S&M - DS; S&M - BIS
Purchase to Pay Curriculum	S&M - DS	S&M - DS
DS Managed Services Training Presales	S&M - DS	S&M - DS
Negotiation and Closing of Business Cases	S&M - DS	S&M - DS; S&M - SB&S; S&M - IPS
Negotiation and Closing of Business Cases	S&M - SB&S	S&M - DS; S&M - SB&S; S&M - IPS
Negotiation and Closing of Business Cases	S&M - IPS	S&M - DS; S&M - SB&S; S&M - IPS
Advanced economics - deepen accounting fundamentals	S&M - DS	S&M - DS; S&M - LFP
Advanced economics - deepen accounting fundamentals	S&M - LFP	S&M - DS; S&M - LFP

<colgroup><col><col><col></colgroup><tbody>
</tbody>

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