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

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
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
285
Joe4
Joe4
P
  • Question Question
Maximum number of pairings
Replies
1
Views
262
StephenCrump
S
P
  • Question Question
Lambda or VBA to solve the pairs webinar problem!!!
Replies
0
Views
129
Phantom1
P
R
  • Question Question
Matching positive and negative values
2
Replies
14
Views
2K
Akuini
Akuini
R
  • Question Question
Fuzzy Match different product titles to find Duplicates but with-in same brand name
Replies
2
Views
80
RajK2005
R

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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