[COLOR=navy]Sub[/COLOR] MG21Sep40
[COLOR=navy]Dim[/COLOR] RngA [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] RngB [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Q
[COLOR=navy]Dim[/COLOR] Ray
[COLOR=navy]Dim[/COLOR] Ar [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
With Sheets("Sheet1") '[COLOR=green][B]Sht1[/B][/COLOR]
[COLOR=navy]Set[/COLOR] RngA = .Range(.Range("g5"), .Range("g" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
With Sheets("Sheet2") '[COLOR=green][B]Sht2[/B][/COLOR]
[COLOR=navy]Set[/COLOR] RngB = .Range(.Range("a2"), .Range("a" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
Ray = Array(RngA, RngB)
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] Ar = 0 To UBound(Ray)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Ray(Ar)
[COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
.Add Dn.Value, Array(0, 0)
Q = .Item(Dn.Value)
[COLOR=navy]If[/COLOR] Ar = 0 [COLOR=navy]Then[/COLOR] Q(0) = 1 Else Q(1) = 1
.Item(Dn.Value) = Q
[COLOR=navy]Else[/COLOR]
Q = .Item(Dn.Value)
[COLOR=navy]If[/COLOR] Ar = 0 [COLOR=navy]Then[/COLOR] Q(0) = Q(0) + 1 Else Q(1) = Q(1) + 1
.Item(Dn.Value) = Q
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Next[/COLOR] Ar
[COLOR=navy]Dim[/COLOR] K, msg [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
c = 1
'[COLOR=green][B]Change Sheet5. Name (4 places below) as required[/B][/COLOR]
Sheets("Sheet5").Range("A1:C1").Value = Array("Value", "Sht(1)", "Sht(2)")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .Keys
[COLOR=navy]If[/COLOR] Not .Item(K)(0) = .Item(K)(1) [COLOR=navy]Then[/COLOR]
c = c + 1
Sheets("Sheet5").Cells(c, 1) = K
Sheets("Sheet5").Cells(c, 2) = .Item(K)(0)
Sheets("Sheet5").Cells(c, 3) = .Item(K)(1)
'[COLOR=green][B]Remove line below as req'ed[/B][/COLOR]
msg = msg & "Val= " & K & Space(2) & "Col(1)= " & .Item(K)(0) & Space(2) & "Col(2)" & .Item(K)(1) & Chr(10)
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
'[COLOR=green][B]Remove line below as req'ed[/B][/COLOR]
MsgBox msg
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]