[COLOR="Navy"]Sub[/COLOR] MG19Aug54
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Mth [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & 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
Mth = Format(Dn.Value, "mmm-yyyy")
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Mth) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic(Mth) = CreateObject("Scripting.Dictionary")
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] Not Dic(Mth).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
Dic(Mth).Add (Dn.Offset(, 1).Value), ""
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Range("E1:F1").Value = Array("Mth/Year", "Number")
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
c = c + 1
Cells(c, "E") = k
Cells(c, "F") = Dic(k).Count
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]