Database Style

[NWE]

Hi all,

I am wondering if someone could give me a good example of VBA code for comparing a list of items across two sheets. for example if two worksheets have the following numbers:
WS1 WS2
1 1
2 3
3 5
4 6
5 9
6 8
7 7
8 2
9 4

Notice how they each have the same numbers but in different order..instead of going through and restructuring this, isn't there a way via an array to just compare if a number exists in list 1 and list 2 it is a match?

[Leith Ross]

Hello NWE,

This macro accepts two Ranges and outputs either Empty (All matched) or a 2-D array with the item and a number 1 or 2. The number indicates the list the item is in.



Option Explicit


Function CompareLists(ByRef List1 As Range, ByRef List2 As Range) As Variant


Dim Data1 As Variant
Dim Data2 As Variant
Dim Dict As Object
Dim index As Long
Dim Item As Variant
Dim Key As String
Dim Output As Variant
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet

' // Create 2-D arrays from the Ranges using only the values.
Data1 = List1.Value
Data2 = List2.Value

Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare

' // Add only unique items in List 1 to the dictionary.
' // Flag List 1 entries with a 1.
For Each Item In Data1
Key = Trim(Item)
If Key <> "" Then
If Not Dict.Exists(Item) Then
Dict.Add Key, 1
End If
End If
Next Item

' // Compare items in List 2 with List 1.
' // Flag List 2 items with a 2.
For Each Item In Data2
Key = Trim(Item)
If Key <> "" Then
If Not Dict.Exists(Key) Then
' // Missing - Add to the dictionary.
Dict.Add Key, 2
Else
' // Matched - Remove the dictionary entry.
Dict.Remove Key
End If
End If
Next Item

' // Output unmatched items and the list they came from.
If Dict.Count > 0 Then
ReDim Output(1 To Dict.Count, 1 To 2)

For Each Item In Dict.Keys
index = index + 1
Output(index, 1) = Item
Output(index, 2) = Dict(Item)
Next Item
End If

CompareLists = Output

End Function

[NWE]

Hello NWE,

This macro accepts two Ranges and outputs either Empty (All matched) or a 2-D array with the item and a number 1 or 2. The number indicates the list the item is in.



Option Explicit


Function CompareLists(ByRef List1 As Range, ByRef List2 As Range) As Variant


Dim Data1 As Variant
Dim Data2 As Variant
Dim Dict As Object
Dim index As Long
Dim Item As Variant
Dim Key As String
Dim Output As Variant
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet

' // Create 2-D arrays from the Ranges using only the values.
Data1 = List1.Value
Data2 = List2.Value

Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare

' // Add only unique items in List 1 to the dictionary.
' // Flag List 1 entries with a 1.
For Each Item In Data1
Key = Trim(Item)
If Key <> "" Then
If Not Dict.Exists(Item) Then
Dict.Add Key, 1
End If
End If
Next Item

' // Compare items in List 2 with List 1.
' // Flag List 2 items with a 2.
For Each Item In Data2
Key = Trim(Item)
If Key <> "" Then
If Not Dict.Exists(Key) Then
' // Missing - Add to the dictionary.
Dict.Add Key, 2
Else
' // Matched - Remove the dictionary entry.
Dict.Remove Key
End If
End If
Next Item

' // Output unmatched items and the list they came from.
If Dict.Count > 0 Then
ReDim Output(1 To Dict.Count, 1 To 2)

For Each Item In Dict.Keys
index = index + 1
Output(index, 1) = Item
Output(index, 2) = Dict(Item)
Next Item
End If

CompareLists = Output

End Function


Thank you for this. I am going to work on this and input it into my worksheet, I will be back in a few days with my results and/or questions if that is ok?

[Leith Ross]

Hello NWE,

Not a problem for me.