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

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
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
Formula to make list shorter
2
Replies
12
Views
1K
Yaseraliakram
Y
R
  • Question
longest prefix match
Replies
1
Views
1K
Eric W
Eric W
E
  • Question
Urgent Formula/Macros assitance
Replies
2
Views
417
Eugene Hirdes
E
J
  • Question
Update the new colum
Replies
2
Views
521
jitendra
J

Forum statistics

Threads
1,215,004
Messages
6,122,656
Members
449,091
Latest member
peppernaut

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