[COLOR="Navy"]Sub[/COLOR] MG02Dec04
[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] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("A1:A50")
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Interior.Color) [COLOR="Navy"]Then[/COLOR]
.Add Dn.Interior.Color, Dn
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] .Item(Dn.Interior.Color) = Union(.Item(Dn.Interior.Color), Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
.Item(K).Offset(, 1).Value = Mid(Application _
.Rept("," & .Item(K).Count, .Item(K).Count), 2)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]