[COLOR="Navy"]Sub[/COLOR] MG09Apr38
'Mg mod
[COLOR="Navy"]Dim[/COLOR] rParents [COLOR="Navy"]As[/COLOR] Range, rNode [COLOR="Navy"]As[/COLOR] Range, rOut [COLOR="Navy"]As[/COLOR] Range, mRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
[COLOR="Navy"]Set[/COLOR] rParents = Range("A2", Range("A2").End(xlDown))
[COLOR="Navy"]Set[/COLOR] rOut = Range("D2")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] rNode [COLOR="Navy"]In[/COLOR] rParents
[COLOR="Navy"]If[/COLOR] Not Dic.Exists(rNode.Value) [COLOR="Navy"]Then[/COLOR] Dic.Add rNode.Value, New Collection
Dic(rNode.Value).Add (rNode.Offset(, 1).Value)
[COLOR="Navy"]Next[/COLOR] rNode
Call DisplayTree("PDX", Dic, rOut, lRow, 0)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
'[COLOR="Green"][B] Display the tree[/B][/COLOR]
[COLOR="Navy"]Sub[/COLOR] DisplayTree(ByVal sParent [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Dic, rOut [COLOR="Navy"]As[/COLOR] Range, _
ByRef lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ByVal lLevel [COLOR="Navy"]As[/COLOR] Long)
[COLOR="Navy"]Dim[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, rr [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] vChild
[COLOR="Navy"]If[/COLOR] lLevel + lRow = 0 [COLOR="Navy"]Then[/COLOR] rOut = sParent
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] vChild [COLOR="Navy"]In[/COLOR] Dic(sParent)
lRow = lRow + 1
rOut(lRow, lLevel + 2) = vChild
'[COLOR="Green"][B]Added here !![/B][/COLOR]
[COLOR="Navy"]If[/COLOR] lRow > 1 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range(rOut(lRow, 1).Address & ":" & rOut(lRow, lLevel + 1).Address)
[COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] For
Dn = Dn.Offset(-1)
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] Dic.Exists(vChild) [COLOR="Navy"]Then[/COLOR]
lRow = lRow - 1 '[COLOR="Green"][B]< Added Here !![/B][/COLOR]
Call DisplayTree(vChild, Dic, rOut, lRow, lLevel + 1)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] vChild
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]