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

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

Post by zwestbroo » Sat, 20 Sep 2008 03:55:28


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

Post by SmltIFRob2 » Sat, 20 Sep 2008 04:12:12

ere 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
 
 
 

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

Post by Paul » Sat, 20 Sep 2008 04:13:14

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



: 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

Post by zwestbroo » Sat, 20 Sep 2008 04:41:19


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

Post by RB Smissae » Sat, 20 Sep 2008 06:32:49

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






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