Compare data

[ruifazenda]

I've a worksheet with data in 2 columns and i need compare then and extract the diferences to another columns.
There is a problem because i've repetitions in both columns and my macro doesn't work properly with this.
I think i need a new macro to do this.

Data1	Data2
100	100
100	200
100	200
200	300
300	500
400	600
600	600
700	800
900

<tbody>
</tbody>

Results:

Faults:	Data1	Data2
	500	400
	800	700
		900

<tbody>
</tbody>

This is wrong
REAL Faults are:

Data1	Data2
200	100
500	100
600	400
800	700
	900

<tbody>
</tbody>

Macro:

Sub abc()
Dim i As Long, ii
Dim arrBank, arrAccounting, arrOutput

arrBank = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)
arrAccounting = Range("b2:b" & Cells(Rows.Count, "b").End(xlUp).Row)


With CreateObject("scripting.dictionary")
.CompareMode = 1
For i = 1 To UBound(arrBank)
.Item(arrBank(i, 1)) = Array(arrBank(i, 1), arrBank(i, 1))
Next

ReDim arrOutput(1 To UBound(arrAccounting), 1 To 1)
For i = 1 To UBound(arrAccounting)
If Not .exists(arrAccounting(i, 1)) Then
ii = ii + 1
arrOutput(ii, 1) = arrAccounting(i, 1)

End If
Next
.RemoveAll
Range("e2").Resize(UBound(arrOutput), 1) = arrOutput
For i = 1 To UBound(arrAccounting)
.Item(arrAccounting(i, 1)) = Array(arrAccounting(i, 1))
Next

ii = 0
ReDim arrOutput(1 To UBound(arrBank), 1 To 1)
For i = 1 To UBound(arrBank)
If Not .exists(arrBank(i, 1)) Then
ii = ii + 1
arrOutput(ii, 1) = arrBank(i, 1)

End If
Next
.RemoveAll
Range("f2").Resize(UBound(arrOutput), 1) = arrOutput
End With
Erase arrBank
Erase arrAccounting
Erase arrOutput
End Sub


Can anyone help me?