[COLOR="Navy"]Sub[/COLOR] MG10Mar54
[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] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -Ac)
[COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
.Add Dn.Value, Dn.Offset(, -1) & "," & Dn.Offset(, -2).Value
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]If[/COLOR] InStr(.Item(Dn.Value), Dn.Offset(, -1)) = 0 [COLOR="Navy"]Then[/COLOR]
.Item(Dn.Value) = .Item(Dn.Value) & "," & Dn.Offset(, -1)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]If[/COLOR] InStr(.Item(Dn.Value), Dn.Offset(, -2)) = 0 [COLOR="Navy"]Then[/COLOR]
.Item(Dn.Value) = .Item(Dn.Value) & "," & Dn.Offset(, -2)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, S [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant, S2 [COLOR="Navy"]As[/COLOR] Variant, Sp2 [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
Sp = Split(.Item(K), ",")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] S [COLOR="Navy"]In[/COLOR] Sp
[COLOR="Navy"]If[/COLOR] .exists(S) [COLOR="Navy"]Then[/COLOR]
Sp2 = Split(.Item(S), ",")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] S2 [COLOR="Navy"]In[/COLOR] Sp2
[COLOR="Navy"]If[/COLOR] InStr(.Item(K), S2) = 0 [COLOR="Navy"]Then[/COLOR]
Q = .Item(K)
Q = Q & "," & S2
.Item(K) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] S2
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] S
[COLOR="Navy"]Next[/COLOR] K
Range("E1:F1").Value = Array("Manager", "No of FTE'[COLOR="Green"][B]s")[/B][/COLOR]
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
c = c + 1
Cells(c, "E") = K
Cells(c, "F") = UBound(Split(.Item(K), ",")) + 1
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]