[COLOR=navy]Sub[/COLOR] MG09Nov02
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Hd [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Sht [COLOR=navy]As[/COLOR] Variant, Hds() [COLOR=navy]As[/COLOR] Variant, uBd [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Shts [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant, Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] uDic [COLOR=navy]As[/COLOR] Variant
c = 0
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]Set[/COLOR] uDic = CreateObject("scripting.dictionary")
uDic.CompareMode = vbTextCompare
'[COLOR=green][B]Change sheet Names in "Array" below for all the sheet to loop through.[/B][/COLOR]
Sht = Array("Sheet4", "Sheet5", "Sheet6")
[COLOR=navy]
For[/COLOR] Hd = 0 To UBound(Sht)
Ray = Sheets(Sht(Hd)).Cells(1).CurrentRegion
[COLOR=navy]For[/COLOR] n = 1 To UBound(Ray, 2)
[COLOR=navy]If[/COLOR] Not .Exists(Ray(1, n)) [COLOR=navy]Then[/COLOR]
p = p + 1
.Add Ray(1, n), p
[COLOR=navy]End[/COLOR] If
[COLOR=navy]If[/COLOR] Not uDic.Exists(Sht(Hd) & Ray(1, n)) [COLOR=navy]Then[/COLOR]
uDic.Add Sht(Hd) & Ray(1, n), n
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
oMax = Application.Max(oMax, UBound(Ray, 1)) + 1
[COLOR=navy]Next[/COLOR] Hd
c = 0
ReDim nray(1 To oMax, 1 To .Count + 1)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
c = c + 1
nray(1, c) = K
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]Dim[/COLOR] Dic [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
c = 1
[COLOR=navy]
For[/COLOR] Hd = 0 To UBound(Sht)
Ray = Sheets(Sht(Hd)).Cells(1).CurrentRegion
[COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
Txt = Ray(n, uDic(Sht(Hd) & "Forename")) & Ray(n, uDic(Sht(Hd) & "Surname"))
[COLOR=navy]If[/COLOR] Not Dic.Exists(Txt) [COLOR=navy]Then[/COLOR]
c = c + 1
Dic.Add Txt, c
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] Hd
[COLOR=navy]
For[/COLOR] Hd = 0 To UBound(Sht)
Ray = Sheets(Sht(Hd)).Cells(1).CurrentRegion
[COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
[COLOR=navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
Txt = Ray(n, uDic(Sht(Hd) & "Forename")) & Ray(n, uDic(Sht(Hd) & "Surname"))
nray(Dic(Txt), .Item(Ray(1, Ac))) = Ray(n, Ac)
[COLOR=navy]Next[/COLOR] Ac
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] Hd
[COLOR=navy]End[/COLOR] With
[COLOR=navy]
With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, UBound(nray, 2))
.Value = nray
.Borders.Weight = 2
.Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
