Here is some code that I use (similar to anywayts). You MUST reference the
project to "Microsoft Scripting Runtime" (In the VBE Tools-References...)

Private Sub MatchedAandB()
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 varMatched As Variant 'Array of unmatched items
Dim wksNew As Worksheet
Dim lngCounter As Long

blnValidRanges = True

On Error Resume Next
Set rngRange1 = Intersect(UsedRange, range("A:A"))
Set rngRange2 = Intersect(UsedRange, range("B:B"))
Set Dic1 = CreateDictionary(rngRange1)
Set Dic2 = CreateDictionary(rngRange2)
varMatched = MatchedArray(Dic1, Dic2)
If IsArray(varMatched) Then
Set wksNew = Sheets.Add
With wksNew
.Range("A1").Value = "Matched Items"
Set rngCurrent = .Range("A2")
For lngCounter = LBound(varMatched) To UBound(varMatched)
rngCurrent.Value = varMatched(lngCounter)
Set rngCurrent = rngCurrent.Offset(1, 0)
Next lngCounter

End With
Else
MsgBox "No Matching Items", vbOKOnly, "No Matches"
End If

End If
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 MatchedArray(ByVal Dic1 As Scripting.Dictionary, _
ByVal Dic2 As Scripting.Dictionary) As Variant
Dim dicItem As Variant
Dim aryMatched() As String
Dim lngCounter As Long

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

If lngCounter = 0 Then
MatchedArray = Empty
Else
MatchedArray = aryMatched
End If
End Function

--
HTH...

Jim Thomlinson


"Bob" wrote:

Columns A & B contain several thousand Project Numbers (e.g., P1052, PA844,
P6721.6, etc.). Column A has the latest list of Project Numbers. Column B
has an older list of Project Numbers. As such, column B is a subset of
column A. I need to find all of the €œnew€� (i.e., unique) Project Numbers
that exist in column A relative to column B, and put the results in column C.
Please note that row 1 is used for column headings, so the data contained in
columns A and B start in row 2.

I would appreciate any help in writing a macro that compares the Project
Numbers in columns A and B and outputs the unique Project Numbers to column C
(starting in row 2). The macro would know to stop when it encounters the
last Project Number in column A (FYI - there are blank cells after the last
Project Number in column A, which obviously is the longest of the two
columns).

Thanks for the help.
Bob