VBA to move Repating and Non-Repeating Names into separated columns

[aaaaa34]

Hey guys,

In the file, you will see league names and their countries. In some countries, unique league names are used, such as: USA - MLS League. But, in some countries, same names are used, such as Bundesliga are used both in Germany and Austria. In the file, you will see these along A and B columns. VBA code needs to move repeated and non-repeated league names into sepated columns with its countries.

Please check the file here. https://jmp.sh/uW2xiRt (Click on the "Download" button on up-right part of the page)
Thanks a lot for for your responses.

 

[MickG]

Try this for results starting "D1"

[COLOR="Navy"]Sub[/COLOR] MG21Jun38
[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] R [COLOR="Navy"]As[/COLOR] Range, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", 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
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
[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] a [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
ReDim Ray(1 To Rng.Count, 1 To 4)
Ray(1, 1) = "League": Ray(1, 2) = "Country"
Ray(1, 3) = "Leaque": Ray(1, 4) = "Country"
c = 1: a = 1

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   [COLOR="Navy"]If[/COLOR] .Item(K).Count = 1 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Ray(c, 1) = K
        Ray(c, 2) = .Item(K).Offset(, 1)
   [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]If[/COLOR] .Item(K).Count > 1 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)
            a = a + 1
            Ray(a, 3) = K
            Ray(a, 4) = R.Offset(, 1)
        [COLOR="Navy"]Next[/COLOR] R
    [COLOR="Navy"]End[/COLOR] If
oMax = Application.Max(c, a)
[COLOR="Navy"]Next[/COLOR] K

Range("D1").Resize(oMax, 4) = Ray

[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...n-repeating-names-into-separated-columns.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[aaaaa34]

MickG,
It worked very so clean and with zero-error.
Thank you bro, thanks a lot.
Also pls forgive me for the convenience about my post in the other forum.
Just, when users did not reply me there, I posted it here. No any bad intention else.
Thanks again brro, thank you.

 

[aaaaa34]

oke Mr. Moderator.
I will be careful about that.
Thanks for ur understanding.
Nice weekend.

 

[MickG]

You're welcome