Compare, Concatenate & Delete

[DHeinsma]

Hello,

I'm using Excel 2007 and am stuck.

I'm getting this out of a database from 2 tables, where I need to change it from 2 tables (ID's on one, and Reasons a differ. table), and combine it to 1 table where reason is now just another field but now the reasons are combined to one field rather than separate records. Since I can't get permission to create a new table and do the magic there with functions and strings, I'm forced to use excel.

I have something like the following:
ID Name Version Reason
1b Colgate 2.0 Whitener<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
2x Crest Alpha Branded<o></o>
1b Colgate 2.0 Tastes Good<o></o>
3x Sensadine 3 Gentle<o></o>
2x Crest Alpha Tastes Good<o></o>
1b Colgate 2.0 Colorful/Swirly
<o></o>
I need to compare the ID's, if they're the same, then concatenate the reason into a 5th column, separated by semi-colons, and finally delete all extraneous columns so it would look like:


ID Name Version Reasons <o></o>
1b Colgate 2.0 Whitener; Tastes Good; Colorful/Swirly<o></o>
2x Crest Alpha Branded; Tastes Good<o></o>
3x Sensadine 3 Gentle<o></o>

If the Reasons could be sorted, great, but that's just a want.

I should have added that a macro for this would be great! I'll need to tweak it for the multiple instances that it'll be used, but this alone will be huge!

Thanks.

 

[Peter_SSs]

DHeinsma

Welcome to the MrExcel board!

See if this is what you want. It assumes Table starts in cell A1.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Rearrange()<br>    <SPAN style="color:#00007F">Dim</SPAN> myRange <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> myRange = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 4)<br>    myRange.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes<br>    <SPAN style="color:#00007F">For</SPAN> r = myRange.Rows.Count <SPAN style="color:#00007F">To</SPAN> 3 <SPAN style="color:#00007F">Step</SPAN> -1<br>        <SPAN style="color:#00007F">If</SPAN> Cells(r, 1).Value = Cells(r - 1, 1).Value <SPAN style="color:#00007F">Then</SPAN><br>            Cells(r - 1, 4).Value = Cells(r - 1, 4).Value & ", " & Cells(r, 4).Value<br>            Rows(r).Delete<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[DHeinsma]

Holy cow! That is perfect!
Goodness, I spent the last part of my day today hitting brick walls and this is absolutely beautiful! You totally made my week-end run so much smoother.

I keep looking at this, re-running it. And it is *sigh* beautiful. I can't thank you enough.

 

[Peter_SSs]

Glad it worked how you wanted. I did mean to add one more line. Immediately after the "Next r" line, you might like to add this line to ensure the Reason column is widened/narrowed automatically to fit the concatenated reasons.

Columns(myRange.Column + myRange.Columns.Count - 1).AutoFit

Enjoy the rest of your weekend.

 

[DHeinsma]

Thank you once again. This was such a hang-up for me and nothing I researched was helpful.