Compare Columns VBA

[Brentsa]

Over this weekend I realized a error in the VBA result

VBA Code:
Sub CompareData()
Sheets("Calculator").Activate
Columns("A:G").Select
Selection.Style = "Comma"

'Compare Column A & B
Dim lrA As Long, lrB As Long

lrA = Range("A" & Rows.Count).End(xlUp).Row
lrB = Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Range("C1").Formula2 = Replace(Replace("=SORT(FILTER(A1:A@,ISNUMBER(MATCH(A1:A@,B1:B#,0)),""""))", "@", lrA), "#", lrB)
Range("D1").Formula2 = Replace(Replace("=SORT(FILTER(A1:A@,ISNUMBER(MATCH(A1:A@,B1:B#,0)),""""))", "@", lrA), "#", lrB)
Range("F1").Formula2 = Replace(Replace("=SORT(FILTER(A1:A@,ISNA(MATCH(A1:A@,B1:B#,0)),""""))", "@", lrA), "#", lrB)
Range("G1").Formula2 = Replace(Replace("=SORT(FILTER(B1:B#,ISNA(MATCH(B1:B#,A1:A@,0)),""""))", "@", lrA), "#", lrB)
With Intersect(ActiveSheet.UsedRange, Columns("C:G"))
.Value = .Value
End With
Columns("A:B").Delete
Application.ScreenUpdating = True
'Sort all Columns in ascending number format
Sheets("Calculator").Range("A:G", Range("A:G").End(xlDown)).Sort Key1:=Range("A:G"), Order1:=xlAscending, Header:=xlNo
Columns("A:G").Select
Selection.Style = "Comma"
Range("a1").Select

End Sub

In Column A is have duplicate numbers and Column B I have only one matching number. At the moment the VBA code eliminates both numbers in Column A as it has found corresponding number in Column B. What I need is for it to only elimate one set matching number and move the other non matching number to column. For example Column A has 8 and 12 in it twice. Column B has 8 twice but 12 once.

Sheet1
	A	B
Book1
1
2	1	2
3	9	3
4	8	4
5	10	6
6	one	8
7	3	one
8	two	four
9	12	9
10	7	12
11	4	15
12	13	1
13	11	5
14	22	8
15	12
16	8

So the results should look like this:

Sheet2
	A	B	C	D	E
Book1
1
2	1	1		7	2
3	3	3		10	5
4	4	4		11	6
5	8	8		12	15
6	8	8		13
7	9	9		22
8	12	12

 

[offthelip]

No trouble ( once I started solving the correct problem!!)