ruifazenda
New Member
- Joined
- May 29, 2019
- Messages
- 1
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.
<tbody>
</tbody>
Results:
<tbody>
</tbody> This is wrong
REAL Faults are:
<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?
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>
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?