PDA

View Full Version : Comparing columns



bmquiroz
03-21-2007, 10:47 AM
Hi all,

Need some help putting together a macro that will compare two columns.

Here is a sample of what I need to compare.



Column A Column B
Chuck F. Martin, Jr. John D. Beletic
Christopher Pewinton Geoffrey D. Cible
Greg B. Gales Joan Q. Nlatt
Harold V. Lorgenti Martin, Jr. Chuck
Chris Pewinton Chuck Martin

The macro should loop through each cell in column A then loop through column B to find any matches. I only need to match the first and last names, so any middle initials, prefix, or suffix should be removed. In the above sample, the macro would find two matches in column B for ?Chuck F. Martin, Jr.?. I?m trying to use Regexp but need some help getting the expression down.

Any help would be appreciated.

Thanks.


Sub Find_Matches()
Dim objRegEx As VBScript_RegExp_55.RegExp
Dim colMatches As VBScript_RegExp_55.MatchCollection
Dim objMatch As VBScript_RegExp_55.Match
Dim myRangeA As Range, myRangeB As Range, x As Variant, y As Variant

Set myRangeA = Application.InputBox _
(Prompt:="Select range A", Title:="Select range", Type:=8)
myRangeA.Select

Set myRangeB = Application.InputBox _
(Prompt:="Select range B", Title:="Select range", Type:=8)

For Each x In myRangeA

For Each y In myRangeB
Set objRegEx = CreateObject("VBScript.RegExp")

objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.Pattern = "???????"

strSearchString = x
Set colMatches = objRegEx.Execute(strSearchString)

If colMatches.Count > 0 Then


strMessage = "Found " & colMatches.Count & " match(es) for " & x & vbCrLf
For Each strMatch In colMatches
strMessage = strMessage & "Found " & y & vbCrLf

Next

MsgBox strMessage

End If
Next y

Next x

End Sub