Merging Multiple Entries for Similar Data

[DogInYellowCoat]

Hi everyone,

I need help merging some data together. I have a spreadsheet with 2 columns. Column A contains an ID number, and column B contains specific information about that ID number. There can be multiple entries in Column A, all with unique information in column B for each occurance of that ID number. For Example:

Col A Col B
1 Needs Repair
1 Insurance Information
1 Data Stored in Location X
2 Insurance Data Collected
2 Date of Repair

I have that 2 tables of that style of information (close to 85 thousand records). I want to merge the data together so that Col A will have 1 entry per case, and col B will merge all of the various details for each case into 1 cell, like this:

Col A Col B
1 Needs Repair, Insurance Information, Data Stored In Location X
2 Insurance Data Collected, Date of Repair

Can anyone please help? The formatting for Col B's compelted state can be whatever it needs to be, as long as all of the information is availble. If a Return between entries is possible, that would be ideal!

I'm sure this would require some sort of Macro, which I have no experience writing. Once I merage this data, I am using a VLOOKUP function to merge the Col B into a seperate sheet.

THANK YOU SO MUCH!!

 

[MickG]

Hi, Try this Results Start "F1".

[COLOR="Navy"]Sub[/COLOR] MG03Aug49
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Ray = Rng.Resize(, 2)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Ray)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Ray(Rw, 1)) [COLOR="Navy"]Then[/COLOR]
        .Add Ray(Rw, 1), Ray(Rw, 2)
    [COLOR="Navy"]Else[/COLOR]
        .Item(Ray(Rw, 1)) = .Item(Ray(Rw, 1)) & "," & Ray(Rw, 2)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("F1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick