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.

[TABLE="width: 96"]
<tbody>[TR]
[TD="class: et2, width: 64"]Data1[/TD]
[TD="class: et2, width: 64"]Data2[/TD]
[/TR]
[TR]
[TD="class: et3, width: 64"]100[/TD]
[TD="class: et3, width: 64"]100[/TD]
[/TR]
[TR]
[TD="class: et3, width: 64"]100[/TD]
[TD="class: et4, width: 64"]200[/TD]
[/TR]
[TR]
[TD="class: et3, width: 64"]100[/TD]
[TD="class: et4, width: 64"]200[/TD]
[/TR]
[TR]
[TD="class: et4, width: 64"]200[/TD]
[TD="class: et1, width: 64"]300[/TD]
[/TR]
[TR]
[TD="class: et1, width: 64"]300[/TD]
[TD="class: et1, width: 64"]500[/TD]
[/TR]
[TR]
[TD="class: et1, width: 64"]400[/TD]
[TD="class: et5, width: 64"]600[/TD]
[/TR]
[TR]
[TD="class: et5, width: 64"]600[/TD]
[TD="class: et5, width: 64"]600[/TD]
[/TR]
[TR]
[TD="class: et1, width: 64"]700[/TD]
[TD="class: et1, width: 64"]800[/TD]
[/TR]
[TR]
[TD="class: et1, width: 64"]900[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Results:

[TABLE="width: 144"]
<tbody>[TR]
[TD="class: et1, width: 64"]Faults:[/TD]
[TD="class: et2, width: 64"]Data1[/TD]
[TD="class: et2, width: 64"]Data2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="class: et1, width: 64"]500[/TD]
[TD="class: et1, width: 64"]400[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="class: et1, width: 64"]800[/TD]
[TD="class: et1, width: 64"]700[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="class: et1, width: 64"]900[/TD]
[/TR]
</tbody>[/TABLE]
This is wrong
REAL Faults are:
[TABLE="width: 128"]
<tbody>[TR]
[TD]Data1[/TD]
[TD]Data2[/TD]
[/TR]
[TR]
[TD]200[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]500[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]600[/TD]
[TD]400[/TD]
[/TR]
[TR]
[TD]800[/TD]
[TD]700[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]900[/TD]
[/TR]
</tbody>[/TABLE]

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?