[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1089521b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1089521-find-pairs-data.html[/COLOR][/I]
[I][COLOR=seagreen]'find duplicate pair[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] m [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb, vc, z, s, vax, vbx
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
vax = Range([COLOR=brown]"A1:B"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)
vbx = Range([COLOR=brown]"C1:D"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)
[COLOR=Royalblue]ReDim[/COLOR] va([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vax, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vbx, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
va(i, [COLOR=crimson]1[/COLOR]) = vax(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]":"[/COLOR] & vax(i, [COLOR=crimson]2[/COLOR])
[COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vb, [COLOR=crimson]1[/COLOR])
vb(i, [COLOR=crimson]1[/COLOR]) = vbx(i, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]":"[/COLOR] & vbx(i, [COLOR=crimson]2[/COLOR])
[COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]ReDim[/COLOR] vc([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]) + UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])
[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
z = va(i, [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]If[/COLOR] d.Exists(z) [COLOR=Royalblue]Then[/COLOR]
d(z) = d(z) & [COLOR=brown]","[/COLOR] & i
[COLOR=Royalblue]Else[/COLOR]
d(z) = i
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]If[/COLOR] d.Exists([COLOR=brown]""[/COLOR]) [COLOR=Royalblue]Then[/COLOR] d.Remove [COLOR=brown]""[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vb, [COLOR=crimson]1[/COLOR])
z = vb(i, [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]If[/COLOR] d.Exists(z) [COLOR=Royalblue]Then[/COLOR]
s = Split(d(z), [COLOR=brown]","[/COLOR])
m = s(UBound(s))
k = k + [COLOR=crimson]1[/COLOR]
vc(k, [COLOR=crimson]1[/COLOR]) = vbx(i, [COLOR=crimson]1[/COLOR]): vc(k, [COLOR=crimson]2[/COLOR]) = vbx(i, [COLOR=crimson]2[/COLOR])
Range([COLOR=brown]"A"[/COLOR] & m).Resize(, [COLOR=crimson]2[/COLOR]).ClearContents
Range([COLOR=brown]"C"[/COLOR] & i).Resize(, [COLOR=crimson]2[/COLOR]).ClearContents
[COLOR=Royalblue]If[/COLOR] UBound(s) = [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
d.Remove z
[COLOR=Royalblue]Else[/COLOR]
d(z) = Left(d(z), Len(d(z)) - Len(m) - [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]If[/COLOR] k > [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] Sheets([COLOR=brown]"Sheet2"[/COLOR]).Range([COLOR=brown]"A2"[/COLOR]).Resize(k, [COLOR=crimson]2[/COLOR]) = vc
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]