VBA code to display most frequent text

[JPM]

I have a range D2:D2500 with various names of clients. I am trying to figure out a VBA solution to display which one appears the most time.
On another thread other board contributors helped me with finding various array formula solution. ( http://www.mrexcel.com/forum/showthread.php?p=2641535#post2641535 )

But I am now looking for a VBA solution to display the result in MsgBox.

Any ideas?

 

[mlo356]

Try this:-
Numbers in column "D" (Starting row2)results in columns "G & H".

[COLOR=navy]Sub[/COLOR] MG20Jan30
[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]
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant, Dic [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
[COLOR=navy]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & 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, 1
            [COLOR=navy]Else[/COLOR]
                .Item(Dn.Value) = .Item(Dn.Value) + 1
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR]
        Cells(1, "G") = "Top 3 No'[COLOR=#808080][B]s": Cells(1, "H") = "Count"[/B][/COLOR]
        c = 1
[COLOR=navy]For[/COLOR] n = 1 To 3
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
        [COLOR=navy]If[/COLOR] .Item(K) = Application.Large(.items, n) [COLOR=navy]Then[/COLOR]
           [COLOR=navy]If[/COLOR] Not Dic.Exists(K) [COLOR=navy]Then[/COLOR]
                Dic.Add K, ""
                c = c + 1
                Cells(c, "G") = K: Cells(c, "H") = .Item(K)
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] K
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Works Great. Thank you very much.

 

[MickG]

You're welcome