Posted to microsoft.public.excel.programming
|
|
Finding Unique Entries Among Two Columns
John,
When I change the first line to "Public" and then run the macro, I get the
following error message:
Compile error:
Sub or Function not defined
VBE then highlights "CreateDictionary" in the line:
Set Dic1 = CreateDictionary(rngRange1)
Bob
"John" wrote:
Hi Bob,
Change the first line:
"Private Sub MatchedAandB()"
to
"Public Sub MatchedAandB()"
You can look up "Understanding Scope and Visibility" in the VBE help for
details.
Best regards
John
"Bob" wrote in message
...
Jim,
Please forgive my ignorane (I'm a novice VB programmer), but I copied your
code to a module. I then went to execute it (using Excel's menus: Tools |
Macro | Macros...), but I didn't see anything listed. Could you please
tell
me how I run your macro?
Thanks, Bob
"Jim Thomlinson" wrote:
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
|