Create Comma Delimited One Row of Data from multiple rows

[gwynwjones]

Hi,

I have a list of data and need it converted to one row per country:

Country DIAL CODE
AFGHANISTAN 93
AFGHANISTAN MOB AFGHAN TEL 9374
AFGHANISTAN MOB AFGHAN TEL 9375
AFGHANISTAN MOB AWCC 9370
AFGHANISTAN MOB AWCC 9371
AFGHANISTAN MOB MTN 9376
AFGHANISTAN MOB MTN 9377
AFGHANISTAN MOB MTN 9378
AFGHANISTAN MOB MTN 9379

This needs to be converted to:
Country DIAL CODE
AFGHANISTAN 93
AFGHANISTAN MOB AFGHAN TEL 9374,9375
AFGHANISTAN MOB AWCC 9370,9371
AFGHANISTAN MOB MTN 9376,9377,9378,9379

I have thousands of rows so need an automated way to do this.

Help please!!

Thanks

 

[gwynwjones]

Can you show an example of the data it worked on including a small number of rows that it failed on.
Also do you know the line of code it failed on .

Worked on this:

AFGHANISTAN 93
AFGHANISTAN MOB AFGHAN TEL 9374
AFGHANISTAN MOB AFGHAN TEL 9375
AFGHANISTAN MOB AWCC 9370
AFGHANISTAN MOB AWCC 9371
AFGHANISTAN MOB MTN 9376
AFGHANISTAN MOB MTN 9377
AFGHANISTAN MOB ROSHAN 9372
AFGHANISTAN MOB ROSHAN 9379
AFGHANISTAN MOBILE 937
ALASKA 1907

It failed when it got to ANTIGUA BARBUDA MOBILE 1268788. This was the 27th record of ANTIGUA BARBUDA MOBILE

Failed on - Range("C1").Resize(.Count) = Application.Transpose(.items)

Cheers

 

[MickG]

Try this:-
I think the "255 Character Limit" appears to affect the "Dic.items" method I used.

[COLOR="Navy"]Sub[/COLOR] MG27Apr06
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Application.ScreenUpdating = False
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
     [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Dn.Value, Dn.Offset(, 1).Value
        [COLOR="Navy"]Else[/COLOR]
           Dic(Dn.Value) = Dic(Dn.Value) & ", " & Dn.Offset(, 1).Value
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    c = c + 1
    Cells(c, "D") = K
    Cells(c, "E") = Dic(K)
[COLOR="Navy"]Next[/COLOR] K
Range("D1").Resize(Dic.Count, 2).Columns.AutoFit
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[gwynwjones]

Try this:-
I think the "255 Character Limit" appears to affect the "Dic.items" method I used.

[COLOR="Navy"]Sub[/COLOR] MG27Apr06
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Application.ScreenUpdating = False
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
     [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Dn.Value, Dn.Offset(, 1).Value
        [COLOR="Navy"]Else[/COLOR]
           Dic(Dn.Value) = Dic(Dn.Value) & ", " & Dn.Offset(, 1).Value
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    c = c + 1
    Cells(c, "D") = K
    Cells(c, "E") = Dic(K)
[COLOR="Navy"]Next[/COLOR] K
Range("D1").Resize(Dic.Count, 2).Columns.AutoFit
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Absolutely superb. Cheers

 

[MickG]

You're welcome