Sulprobil
Search…
sbCompareTwoLists
With a reconciliation you can ensure data integrity or consistency. A simple example is a comparison of two lists. There are many possible approaches to show which elements of list A are not in list B and vice versa.
In principle you can come up either with a realtime comparison or with a batch process to do this. The realtime reconciliation can be done with a worksheet formula (including a conditional format) or with a VBA function. As a rule of thumb you do not want its runtime to be unbearably long - let's say longer than 0.2 sec. The batch process can be a VBA subroutine or a pivot table. This might be your preferred choice if the reconciliation is quite complex or if it lasts quite long (minutes).
Here is an example for a conditional format (volatile worksheet formula):
An example for a batch process solution (a VBA subroutine):
Please read my Disclaimer.
Sub sbCompareTwoLists(rListA As Range, _
rListB As Range, _
rOutput As Range)
'Lists all elements of first list which are not in second one
'together with their row number in output area starting at
'rOutput.
'Reverse ("moc.LiborPlus.www") PB V0.2 25-Aug-2010
Dim objARows As Object, objBRows As Object
Dim i As Long, r As Range
'Clear output area - adjust if necessary
Range(rOutput, rOutput.Offset(4 + rListA.Count + _
rListB.Count, 1)).ClearContents
rOutput = "Elements of List A which are not in B": i = i + 1
rOutput.Offset(i, 0) = "Row #"
rOutput.Offset(i, 1) = "Value": i = i + 1
Set objARows = CreateObject("Scripting.Dictionary")
Set objBRows = CreateObject("Scripting.Dictionary")
'We store row numbers of all list elements in memory
For Each r In rListB
objBRows.Item(r.Text) = r.Row
Next r
For Each r In rListA
objARows.Item(r.Text) = r.Row
If objBRows.Item(r.Text) = 0 Then
'List element of A is not in B
rOutput.Offset(i, 0) = r.Row
rOutput.Offset(i, 1) = r.Text: i = i + 1
End If
Next r
rOutput.Offset(i, 0) = "Elements of List B which are not in A"
i = i + 1
rOutput.Offset(i, 0) = "Row #"
rOutput.Offset(i, 1) = "Value": i = i + 1
For Each r In rListB
If objARows.Item(r.Text) = 0 Then
'List element of B is not in A
rOutput.Offset(i, 0) = r.Row
rOutput.Offset(i, 1) = r.Text: i = i + 1
End If
Next r
Set objARows = Nothing
Set objBRows = Nothing
End Sub
Sub CommandButtonTest()
Call sbCompareTwoLists(Range("A2:A2001"), _
Range("B2:B2001"), Range("D9"))
End Sub
sbCompareTwoLists.xlsm
107KB
Binary
sbCompareTwoLists.xlsm
Copy link