Imperfect Matches
 

My Spreadsheet has one column with a list of Customer NameCodes.
Another column will be filled with comments that include portions of the
NameCodes or the NameCodes plus more characters.

Is there a way to have the macro identify close matches?

Simplified Sample:

A B
JohnD Sold 100 widgets to JohnDoe
Mary Smith Sold John D 100 large widgets
BenH Received from Mary 6 return items

--
Best wishes,

Jim

Imperfect Matches
 

Sub FindMatches()
Dim rng As Range, rng1 As Range
Dim cell As Range, cell1 As Range
Dim bFound As Boolean, v As Variant
Set rng = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
Set rng1 = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
For Each cell In rng
For Each cell1 In rng1
bFound = False
If InStr(1, Replace(cell, " ", ""), Replace(cell1, " ", ""),
vbTextCompare) 0 Then _
bFound = True
If Not bFound Then
v = Split(cell1, " ")
For i = LBound(v) To UBound(v)
If InStr(1, Replace(cell, " ", ""), v(i), vbTextCompare) 0
Then
bFound = True
Exit For
End If
Next i
End If
If bFound Then
cell.Offset(0, 1).Value = cell1
End If
Next
Next
End Sub

as a start.

Against your data it returned

JohnD
JohnD
Mary Smith

--
Regards,
Tom Ogilvy


"Jim Jackson" wrote:

My Spreadsheet has one column with a list of Customer NameCodes.
Another column will be filled with comments that include portions of the
NameCodes or the NameCodes plus more characters.

Is there a way to have the macro identify close matches?

Simplified Sample:

A B
JohnD Sold 100 widgets to JohnDoe
Mary Smith Sold John D 100 large widgets
BenH Received from Mary 6 return items

--
Best wishes,

Jim

Imperfect Matches
 

Thanks, Tom.

I am getting some "false positives" but should be able to iron those out
with some experimentation.
--
Best wishes,

Jim


"Tom Ogilvy" wrote:

Sub FindMatches()
Dim rng As Range, rng1 As Range
Dim cell As Range, cell1 As Range
Dim bFound As Boolean, v As Variant
Set rng = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
Set rng1 = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
For Each cell In rng
For Each cell1 In rng1
bFound = False
If InStr(1, Replace(cell, " ", ""), Replace(cell1, " ", ""),
vbTextCompare) 0 Then _
bFound = True
If Not bFound Then
v = Split(cell1, " ")
For i = LBound(v) To UBound(v)
If InStr(1, Replace(cell, " ", ""), v(i), vbTextCompare) 0
Then
bFound = True
Exit For
End If
Next i
End If
If bFound Then
cell.Offset(0, 1).Value = cell1
End If
Next
Next
End Sub

as a start.

Against your data it returned

JohnD
JohnD
Mary Smith

--
Regards,
Tom Ogilvy


"Jim Jackson" wrote:

My Spreadsheet has one column with a list of Customer NameCodes.
Another column will be filled with comments that include portions of the
NameCodes or the NameCodes plus more characters.

Is there a way to have the macro identify close matches?

Simplified Sample:

A B
JohnD Sold 100 widgets to JohnDoe
Mary Smith Sold John D 100 large widgets
BenH Received from Mary 6 return items

--
Best wishes,

Jim