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

[Gyanendra]

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.

 

[bebo021999]

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
	A	B	C	D	E
1				Dup	Unique
2	1	20		20	1
3	2	21		21	2
4	3	22		22	3
5	4	23		23	4
6	5	24		24	5
7	6	25		25	6
8	7	26		26	7
9	8	27		27	8
10	9	28		28	9
11	10	29		29	10
12	11	30		30	11
13	12	31		31	12
14	13	32		32	13
15	14	33		33	14
16	15	34		34	15
17	16	35		35	16
18	17	36		36	17
19	18	37		37	18
20	19	38		38	19
21	20	39		39	100
22	21	40		40	101
23	22	100			102
24	23	101			103
25	24	102			104
26	25	103			105
27	26	104			106
28	27	105			107
29	28	106			108
30	29	107			109
31	30	108			110
32	31	109			111
33	32	110			112
34	33	111			113
35	34	112			114
36	35	113			115
37	36	114			116
38	37	115			41
39	38	116			42
40	39				43
41	40				44
42	41				45
43	42				46
44	43				47
45	44				48
46	45				49
47	46				50
48	47
49	48
50	49
51	50
Sheet1

Cell Formulas
Range	Formula
A3:A51,B24:B39,B3:B22	B3	=B2+1

 

[Gyanendra]

Hi can you please make few changes
compare both columns A and B and fetch only the duplicate data to E column

 

[bebo021999]

So replace this

Range("D2:E100000").ClearContents
Range("D2").Resize(k2, 1).Value = Dup
Range("E2").Resize(k1, 1).Value = Uni

with

Range("E2:E100000").ClearContents
Range("E2").Resize(k2, 1).Value = Dup

 

[Gyanendra]

will this code be helpful if i try to compare 10lakh row values??

 

[bebo021999]

Just try to test!

 

[Gyanendra]

Its working fine !!!!
Thanks a lot for helping out