[COLOR=Navy]Sub[/COLOR] MG16Jun20
[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]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A7"), Range("A" & Rows.Count).End(xlUp))
Rng.Resize(, 7).Sort Rng(1)
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
[COLOR=Navy]If[/COLOR] Not Dn.Value = "" [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
Dic.Add Dn.Value, Dn
[COLOR=Navy]Else[/COLOR]
[COLOR=Navy]Set[/COLOR] Dic.Item(Dn.Value) = Union(Dic.Item(Dn.Value), Dn)
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] Dic.keys
Dic.Item(K).Offset(, 1).Sort Dic.Item(K).Offset(, 1)(1), xlAscending
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]