[COLOR="Navy"]Sub[/COLOR] MG19Feb03
[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, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Rr [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic1 [COLOR="Navy"]As[/COLOR] Object, Dic2 [COLOR="Navy"]As[/COLOR] Object, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 2)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
Dic1.CompareMode = vbTextCompare
ray(1, 1) = "Rol No": ray(1, 2) = "Inherits": c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic1.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
Dic1.Add Dn.Value, Dn
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic1(Dn.Value) = Union(Dic1(Dn.Value), Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic1.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, 1)
[COLOR="Navy"]If[/COLOR] Not Dic2.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
Dic2.Add Dn.Value, Dn
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic2(Dn.Value) = Union(Dic2(Dn.Value), Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic1.keys
c = c + 1: Dic.RemoveAll
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dic1(K).Offset(, 1)
[COLOR="Navy"]If[/COLOR] Dic2.exists(R.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rr [COLOR="Navy"]In[/COLOR] Dic2(R.Value)
[COLOR="Navy"]If[/COLOR] Not Rr.Offset(, -1).Value = K [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Rr.Offset(, -1).Value) [COLOR="Navy"]Then[/COLOR]
Dic.Add Rr.Offset(, -1).Value, Nothing
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Rr
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
ray(c, 1) = K
ray(c, 2) = Join(Dic.keys(), ",")
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]With[/COLOR] Range("D1").Resize(c, 2)
.Value = ray
.Borders.Weight = 2
.Columns.AutoFit
.HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]