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
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