Create Comma Delimited One Row of Data from multiple rows

G

gwynwjones

Board Regular
Joined
Mar 17, 2004
Messages
66
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
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
Try this:-
Results start "C1".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Apr05
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, " ")
        Txt = ""
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp) - 1
                Txt = Txt & IIf(Txt = "", Sp(n), " " & Sp(n))
            [COLOR="Navy"]Next[/COLOR] n
        [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
            .Add Txt, Dn.Value
        [COLOR="Navy"]Else[/COLOR]
           .Item(Txt) = .Item(Txt) & ", " & Sp(UBound(Sp))
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("C1").Resize(.Count) = Application.Transpose(.items)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
Results start "C1".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Apr05
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, " ")
        Txt = ""
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp) - 1
                Txt = Txt & IIf(Txt = "", Sp(n), " " & Sp(n))
            [COLOR="Navy"]Next[/COLOR] n
        [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
            .Add Txt, Dn.Value
        [COLOR="Navy"]Else[/COLOR]
           .Item(Txt) = .Item(Txt) & ", " & Sp(UBound(Sp))
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("C1").Resize(.Count) = Application.Transpose(.items)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
Click to expand...

Cheers Mick but it's giving an error - says Type mismatch then highlights this in yellow Range("C1").Resize(.Count) = Application.Transpose(.items)
 
Upvote 0
So there are only 2 columns of data, "A & B"
Do you want the resulting end Numbers, that are shown delimited with commas, to be in one column of Multi columns.
 
Last edited:
Upvote 0
Try this for results in "D & E".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Apr25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[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"]With[/COLOR] Range("D1").Resize(Dic.Count, 2)
    .Value = Application.Transpose(Array(Dic.keys, Dic.items))
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this for results in "D & E".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Apr25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[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"]With[/COLOR] Range("D1").Resize(Dic.Count, 2)
    .Value = Application.Transpose(Array(Dic.keys, Dic.items))
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
Click to expand...

Cheers, yes, would like the output in one column
 
Upvote 0
MickG said:
Try this:-
Results start "C1".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG27Apr05
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, " ")
        Txt = ""
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp) - 1
                Txt = Txt & IIf(Txt = "", Sp(n), " " & Sp(n))
            [COLOR="Navy"]Next[/COLOR] n
        [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
            .Add Txt, Dn.Value
        [COLOR="Navy"]Else[/COLOR]
           .Item(Txt) = .Item(Txt) & ", " & Sp(UBound(Sp))
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("C1").Resize(.Count) = Application.Transpose(.items)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
Click to expand...

I go this working but only worked on test batch of about 20 rows, I did it on everything and it errored
 
Upvote 0
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 .
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question Question
Formula to make list shorter
2
Replies
12
Views
1K
Yaseraliakram
Y
R
  • Question Question
longest prefix match
Replies
1
Views
1K
Eric W
Eric W
E
  • Question Question
Urgent Formula/Macros assitance
Replies
2
Views
490
Eugene Hirdes
E
J
  • Question Question
Update the new colum
Replies
2
Views
590
jitendra
J

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top