Find pairs of data

E

excel_root

New Member
Joined
Feb 25, 2019
Messages
8
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

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
After you find the duplicates then what? highlight the cells with yellow?
 
Last edited:
Upvote 0
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]
 
Upvote 0
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
 
Upvote 0
excel_root said:
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
Click to expand...

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:
Upvote 0
Akuini said:
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.
Click to expand...


This works amazing! I really appreciate your efforts and time! Can you just add C:D in the output range too?
 
Upvote 0
excel_root said:
This works amazing! I really appreciate your efforts and time! Can you just add C:D in the output range too?
Click to expand...

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
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Combine pairs of duplicate rows while totalling dollar values for each pair
Replies
1
Views
278
Joe4
Joe4
P
  • Question Question
Maximum number of pairings
Replies
1
Views
248
StephenCrump
S
P
  • Question Question
Lambda or VBA to solve the pairs webinar problem!!!
Replies
0
Views
101
Phantom1
P
R
  • Question Question
Matching positive and negative values
2
Replies
14
Views
1K
Akuini
Akuini
R
  • Solved
Find Duplicates and change font color based on other cell value
Replies
3
Views
305
etaf
etaf

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

Share this page

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top