Compare List A to List B, Return List B Items Not in List A
 

I've searched on the forum and found ways to list duplicate items and
unique items, but this is for a combination of two lists, not
"bumping" one list against another. In this case, I need to compare
List A to List B and return those items in List B that are not in List
A. I scavenged and tweaked some code, but it is trying to do a cell-to-
cell comparison - this won't work as items can be in different
locations within the lists. Thoughts?

Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Cell As Range

Set Rng1 = Range("A1:A13") 'long list
Set Rng2 = Range("B1:B13") 'short list
Set Rng3 = Range("D1") 'output
On Error Resume Next

For Each Cell In Rng2

If Rng2.Cell.Value < Rng1.Cell.Value Then
Rng3.Value = Cell.Value
Set Rng3 = Rng3.Offset(1, 0)
End If

Next Cell
End Sub

Compare List A to List B, Return List B Items Not in List A
 

Here is some long winded code that I have in an addin. It requires a few
things to get started. Create a User Form. Add two RefEdit Controls to the
userform and a command button. The names of the refedits is refRange1 and
refRange2. The command button is cmdOk. You also need to reference the
project to Microsoft Scripting Runtime (Tools | References | Check Microsoft
Scripting Runtime).

The form asks you to select two ranges. When you click ok it creates a new
sheet listing the differences in the two lists...

Private Sub cmdOk_Click()
Dim blnValidRanges As Boolean
Dim rngRange1 As Range
Dim rngRange2 As Range
Dim rngCurrent As Range
Dim Dic1 As Scripting.Dictionary 'Dictionary Object
Dim Dic2 As Scripting.Dictionary 'Dictionary Object
Dim varUnmatched1 As Variant 'Array of unmatched items
Dim varUnmatched2 As Variant 'Array of unmatched items
Dim wksNew As Worksheet
Dim lngCounter As Long

blnValidRanges = True

On Error Resume Next
Set rngRange1 = Range(refRange1.Text)
Set rngRange2 = Range(refRange2.Text)
On Error GoTo ErrorHandler

If rngRange1 Is Nothing Then
blnValidRanges = False
Call ControlError(refRange1)
ElseIf rngRange2 Is Nothing Then
blnValidRanges = False
Call ControlError(refRange2)
End If

If blnValidRanges = True Then
Set rngRange1 = Intersect(rngRange1.Parent.UsedRange, rngRange1)
Set rngRange2 = Intersect(rngRange2.Parent.UsedRange, rngRange2)
Set Dic1 = CreateDictionary(rngRange1)
Set Dic2 = CreateDictionary(rngRange2)
varUnmatched1 = UnmatchedArray(Dic1, Dic2)
varUnmatched2 = UnmatchedArray(Dic2, Dic1)
If IsArray(varUnmatched1) Or IsArray(varUnmatched2) Then
Set wksNew = Sheets.Add
With wksNew
.Range("A1").Value = refRange1.Text
.Range("B1").Value = refRange2.Text
Set rngCurrent = .Range("A2")
If IsArray(varUnmatched1) Then
For lngCounter = LBound(varUnmatched1) To
UBound(varUnmatched1)
rngCurrent.Value = varUnmatched1(lngCounter)
Set rngCurrent = rngCurrent.Offset(1, 0)
Next lngCounter
End If
Set rngCurrent = .Range("B2")
If IsArray(varUnmatched2) Then
For lngCounter = LBound(varUnmatched2) To
UBound(varUnmatched2)
rngCurrent.Value = varUnmatched2(lngCounter)
Set rngCurrent = rngCurrent.Offset(1, 0)
Next lngCounter
End If
End With
Else
MsgBox "There are no unmatched items.", vbOKOnly, "No Unmantched"
End If

End If
Unload Me
End Sub


Private Sub ControlError(ByVal RefControl As Control)
MsgBox "Please select a range to check", vbInformation, "Select Range"
With RefControl
.SelStart = 0
.SelLength = Len(.Text)
.Text = .SelText
.SetFocus
End With
End Sub

Private Function CreateDictionary(ByVal Target As Range) As
Scripting.Dictionary
Dim rngCurrent As Range
Dim dic As Scripting.Dictionary 'Dictionary Object

Set dic = New Scripting.Dictionary
For Each rngCurrent In Target
If Not dic.Exists(rngCurrent.Value) And rngCurrent.Value < Empty
Then 'Check the key
dic.Add rngCurrent.Value, rngCurrent.Value 'Add the item if
unique
End If
Next rngCurrent

Set CreateDictionary = dic
End Function

Private Function UnmatchedArray(ByVal Dic1 As Scripting.Dictionary, _
ByVal Dic2 As Scripting.Dictionary) As Variant
Dim dicItem As Variant
Dim aryUnmatched() As String
Dim lngCounter As Long

lngCounter = 0
For Each dicItem In Dic1
If Not Dic2.Exists(dicItem) Then 'Check the key
ReDim Preserve aryUnmatched(lngCounter)
aryUnmatched(lngCounter) = dicItem
lngCounter = lngCounter + 1
End If
Next dicItem

If lngCounter = 0 Then
UnmatchedArray = Empty
Else
UnmatchedArray = aryUnmatched
End If
End Function
--
HTH...

Jim Thomlinson


"zwestbrook" wrote:

I've searched on the forum and found ways to list duplicate items and
unique items, but this is for a combination of two lists, not
"bumping" one list against another. In this case, I need to compare
List A to List B and return those items in List B that are not in List
A. I scavenged and tweaked some code, but it is trying to do a cell-to-
cell comparison - this won't work as items can be in different
locations within the lists. Thoughts?

Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Cell As Range

Set Rng1 = Range("A1:A13") 'long list
Set Rng2 = Range("B1:B13") 'short list
Set Rng3 = Range("D1") 'output
On Error Resume Next

For Each Cell In Rng2

If Rng2.Cell.Value < Rng1.Cell.Value Then
Rng3.Value = Cell.Value
Set Rng3 = Rng3.Offset(1, 0)
End If

Next Cell
End Sub

Compare List A to List B, Return List B Items Not in List A
 

Have you tried with a collection?
Use the .add method for the first range (List A) into a collection, then use
the .item method to check if items in List B occur in the collection?

Paul D

"zwestbrook" wrote in message
...
: I've searched on the forum and found ways to list duplicate items and
: unique items, but this is for a combination of two lists, not
: "bumping" one list against another. In this case, I need to compare
: List A to List B and return those items in List B that are not in List
: A. I scavenged and tweaked some code, but it is trying to do a cell-to-
: cell comparison - this won't work as items can be in different
: locations within the lists. Thoughts?
:
: Sub ListDuplicateVal()
:
: Dim Rng1 As Range
: Dim Rng2 As Range
: Dim Rng3 As Range
: Dim Cell As Range
:
: Set Rng1 = Range("A1:A13") 'long list
: Set Rng2 = Range("B1:B13") 'short list
: Set Rng3 = Range("D1") 'output
: On Error Resume Next
:
: For Each Cell In Rng2
:
: If Rng2.Cell.Value < Rng1.Cell.Value Then
: Rng3.Value = Cell.Value
: Set Rng3 = Rng3.Offset(1, 0)
: End If
:
: Next Cell
: End Sub

Compare List A to List B, Return List B Items Not in List A
 

On Sep 18, 3:13*pm, "PaulD" <nospam wrote:
Have you tried with a collection?
Use the .add method for the first range (List A) into a collection, then use
the .item method to check if items in List B occur in the collection?

Paul D


Thanks for the tip, Paul...I modified my code a bit but don't know how
to do the comparison...this is not outputting anything:

Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Cell As Range
Dim MyList As Collection

Set Rng1 = Range("A2:A13")
Set Rng2 = Range("B2:B13")
Set Rng3 = Range("D2")
On Error Resume Next

For Each Cell In Rng1
MyList.Add Cell.Value
Next Cell

For Each Cell In Rng2
If Rng2.Cell.Value < MyList.Item(Cell).Value Then
Rng3.Value = Rng2.Cell.Value
Set Rng3 = Rng3.Offset(1, 0)

End If
Next Cell

End Sub

Compare List A to List B, Return List B Items Not in List A
 

You need to do:

Dim MyList As Collection

Set MyList = New Collection

Your On Error Resume Next hides that mistake and always useful to comment
out
error handling when you get un-expected results.


RBS


"zwestbrook" wrote in message
...
On Sep 18, 3:13 pm, "PaulD" <nospam wrote:
Have you tried with a collection?
Use the .add method for the first range (List A) into a collection, then
use
the .item method to check if items in List B occur in the collection?

Paul D


Thanks for the tip, Paul...I modified my code a bit but don't know how
to do the comparison...this is not outputting anything:

Sub ListDuplicateVal()

Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Cell As Range
Dim MyList As Collection

Set Rng1 = Range("A2:A13")
Set Rng2 = Range("B2:B13")
Set Rng3 = Range("D2")
On Error Resume Next

For Each Cell In Rng1
MyList.Add Cell.Value
Next Cell

For Each Cell In Rng2
If Rng2.Cell.Value < MyList.Item(Cell).Value Then
Rng3.Value = Rng2.Cell.Value
Set Rng3 = Rng3.Offset(1, 0)

End If
Next Cell

End Sub