VBA Code to compare two columns and get the duplicate value and unique values in 2 columns

Gyanendra

New Member
Joined
Jun 28, 2023
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
Hi Please Help me with the code.
I want to compare two columns A and B and get the duplicate values and unique values present in different coulumn such as D & E.
 

Attachments

  • Screenshot (237).png
    Screenshot (237).png
    21.8 KB · Views: 25

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
VBA Code:
Option Explicit
Sub test()
Dim lr&, i&, j&, k1&, k2&, num, rng As Range, Dup(), Uni(), dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = WorksheetFunction.Max(Cells(Rows.Count, "A").End(xlUp).Row, Cells(Rows.Count, "B").End(xlUp).Row)
Set rng = Range("A2:B" & lr)
num = rng.Value
ReDim Dup(1 To lr * 2, 1 To 1): ReDim Uni(1 To lr * 2, 1 To 1)
For i = 1 To UBound(num)
    For j = 1 To UBound(num, 2)
        If Not dic.exists(num(i, j)) Then
            dic.Add num(i, j), 1
        Else
            dic(num(i, j)) = dic(num(i, j)) + 1
        End If
    Next
Next
For i = 1 To UBound(num)
    For j = 1 To UBound(num, 2)
        If dic.exists(num(i, j)) Then
            If dic(num(i, j)) = 1 Then
                k1 = k1 + 1: Uni(k1, 1) = num(i, j)
            Else
                k2 = k2 + 1: Dup(k2, 1) = num(i, j)
            End If
            dic.Remove (num(i, j))
        End If
    Next
Next
Range("D2:E100000").ClearContents
Range("D2").Resize(k2, 1).Value = Dup
Range("E2").Resize(k1, 1).Value = Uni
Set dic = Nothing
End Sub


Book1
ABCDE
1DupUnique
2120201
3221212
4322223
5423234
6524245
7625256
8726267
9827278
10928289
1110292910
1211303011
1312313112
1413323213
1514333314
1615343415
1716353516
1817363617
1918373718
2019383819
21203939100
22214040101
2322100102
2423101103
2524102104
2625103105
2726104106
2827105107
2928106108
3029107109
3130108110
3231109111
3332110112
3433111113
3534112114
3635113115
3736114116
383711541
393811642
403943
414044
424145
434246
444347
454448
464549
474650
4847
4948
5049
5150
Sheet1
Cell Formulas
RangeFormula
A3:A51,B24:B39,B3:B22B3=B2+1
 
Upvote 0
Solution
Hi can you please make few changes
compare both columns A and B and fetch only the duplicate data to E column
 
Upvote 0
So replace this
VBA Code:
Range("D2:E100000").ClearContents
Range("D2").Resize(k2, 1).Value = Dup
Range("E2").Resize(k1, 1).Value = Uni
with
VBA Code:
Range("E2:E100000").ClearContents
Range("E2").Resize(k2, 1).Value = Dup
 
Upvote 0

Forum statistics

Threads
1,223,948
Messages
6,175,566
Members
452,652
Latest member
eduedu

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