[COLOR="Navy"]Sub[/COLOR] MG09Aug27
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] nSum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Num2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
nSum = 0
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) = "W" [COLOR="Navy"]Then[/COLOR] nSum = 1
Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Array(1, nSum)
[COLOR="Navy"]Else[/COLOR]
Q = Dic(Dn.Value).Item(Dn.Offset(, 1).Value)
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) = "W" [COLOR="Navy"]Then[/COLOR] Q(1) = Q(1) + 1
Q(0) = Q(0) + 1
Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
c = 1
ReDim ray(1 To Rng.Count, 1 To 3)
ray(1, 1) = "Name": ray(1, 2) = "Most Visited": ray(1, 3) = "Most Successful"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
oMax = 0: oMax2 = 0
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
oMax = Application.Max(Dic(k).Item(p)(0), oMax)
oMax2 = Application.Max(Dic(k).Item(p)(1), oMax2)
[COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
[COLOR="Navy"]If[/COLOR] Dic(k).Item(p)(0) = oMax [COLOR="Navy"]Then[/COLOR] Num1 = Num1 & IIf(Num1 = "", p, ", " & p)
[COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
[COLOR="Navy"]If[/COLOR] Dic(k).Item(p)(1) = oMax2 [COLOR="Navy"]Then[/COLOR] Num2 = Num2 & IIf(Num2 = "", p, ", " & p)
[COLOR="Navy"]Next[/COLOR] p
c = c + 1
ray(c, 1) = k
ray(c, 2) = Num1
ray(c, 3) = Num2
Num1 = "": Num2 = ""
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Range("F1").Resize(c, 3)
.Value = ray
.Borders.Weight = 2
.Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]