Combining Multiple rows with same id into single ones.

[littlevoicez]

Hi This is my first post on this forum, I couldn't find the answer elsewhere, that's why I decided to post it here:

I would like to combine multiple rows with the same id, into one.
Eg.

--------------------------------------------------------------------------------------------
ID (movie Title) | Description | Other Field | link |
--------------------------------------------------------------------------------------------
The Naked Gun | Lorem Ipsum... | bla bla bla | Link 1|
The Naked Gun | | | Link 2|
The Naked Gun | | | Link 3|
Australia | Lorem Ipsum... | bla bla bla | Link 1|
Australia | | | Link 2|
Australia | | | Link 3|
Australia | | | Link 4|
--------------------------------------------------------------------------------------------

Then the above records to be combined into the following 2 rows (one for each id, with the fields with different content, merged into one cell, separated by commas)


The Naked Gun | Lorem Ipsum... | bla bla bla | Link 1, Link 2,Link 3,|

Australia | Lorem Ipsum... | bla bla bla | Link 1,Link 2,Link 3,Link 4|

Can you help me achieve this?
Thanks in advance.

 

[AlphaFrog]

Hi and welcome.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Consolidate_Rows()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> Lastrow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Lastrow = Range("A" & Rows.Count).End(xlUp).Row<br>    <SPAN style="color:#00007F">For</SPAN> r = Lastrow <SPAN style="color:#00007F">To</SPAN> 2 <SPAN style="color:#00007F">Step</SPAN> -1<br>        <SPAN style="color:#00007F">If</SPAN> Range("A" & r).Value = Range("A" & r - 1).Value <SPAN style="color:#00007F">Then</SPAN><br>            Range("D" & r - 1).Value = Range("D" & r - 1).Value & "," & Range("D" & r).Value<br>            Rows(r).Delete xlShiftUp<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    ActiveSheet.UsedRange.Columns.AutoFit<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[littlevoicez]

Thank you, Thank you, Thank you, Thank you, Thank you so much. You made my day and saved me a huge amount of time.
Thanks A billion.

 

[AlphaFrog]

You're welcome.