# Find pairs of data

#### excel_root

##### New Member
Hi everyone,

I would appreciate if anyone can help me. I am trying to write a code, which will find duplicates within two given columns. However, I need only "pairs" to be found - not all duplicates at one time. For example, if column A has 3 values of 50 and column B only two values of 50 - code will find only two values in column A and two in column B - i.e. pairs. Can you please help me?

### Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
After you find the duplicates then what? highlight the cells with yellow?

Last edited:
Sorry, my fault. Duplicates will be copied it to the new worksheet and deleted from the current worksheet

In the new worksheet, the duplicates will be in col A & B?

Yes, in the first two columns

Try this, I put the result in sheet2, you can change it in this line:
Code:
``If k > 0 Then Sheets("Sheet2").Range("A2").Resize(k, 2) = vc``
The code:

Code:
``````[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1089521a()
[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
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]

Range([COLOR=brown]"A:B"[/COLOR]).Interior.Color = xlNone
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
va = Range([COLOR=brown]"A1"[/COLOR], Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
vb = Range([COLOR=brown]"B1"[/COLOR], Cells(Rows.count, [COLOR=brown]"B"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
[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]) = z: vc(k, [COLOR=crimson]2[/COLOR]) = z

Range([COLOR=brown]"A"[/COLOR] & m).ClearContents
Range([COLOR=brown]"B"[/COLOR] & i).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]``````

Thank you so much! It works great!!

I just wanted to ask - can i use this code if I want to add a condition for matching?

Example:
price1 in column A
name1 in column B
price2 in column C
name2 in column D

If price1 and price2 are duplicate pairs, then check if name1 and name2 of the found pair is the same
If both conditions are true for the duplicate pair, cut and paste to the new spreadsheet

Thank you so much! It works great!!

I just wanted to ask - can i use this code if I want to add a condition for matching?

Example:
price1 in column A
name1 in column B
price2 in column C
name2 in column D

If price1 and price2 are duplicate pairs, then check if name1 and name2 of the found pair is the same
If both conditions are true for the duplicate pair, cut and paste to the new spreadsheet

Try this:

Code:
``````[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]``````

Note: I put the result only in column A:B, because the result in column C:D actually are always be the same with column A:B.

Last edited:
Note: I put the result only in column A:B, because the result in column C:D actually are always be the same with column A:B.

This works amazing! I really appreciate your efforts and time! Can you just add C:D in the output range too?

This works amazing! I really appreciate your efforts and time! Can you just add C:D in the output range too?

Ok, just replace this line:
Code:
``If k > 0 Then Sheets("Sheet2").Range("A2").Resize(k, 2) = vc``
with this:
Code:
``````If k > 0 Then
Sheets("Sheet2").Range("A2").Resize(k, 2) = vc
Sheets("Sheet2").Range("C2").Resize(k, 2) = vc
End If``````

Replies
6
Views
140
Replies
1
Views
112
Replies
1
Views
134
Replies
1
Views
249
Replies
1
Views
64

1,196,130
Messages
6,013,622
Members
441,777
Latest member

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back