[AccessD] Any good name matching algorithms in VBA

> On 2 Dec 2011 at 11:47, Edward Zuris wrote:
> 
> >  
> >  Does anyone know where I can find some good name
> >  matching algorithms in VBA, and or examples, that
> >  I can look into ?
> >  
> >  Thanks.
> >  
> >  Ed Zuris.
> >  edzedz at comcast.net
> >  

Function LevenshteinDistance(phrase1 As String, phrase2 As String) As Long
'Calculates the minimum number of edits required to transform
'Phrase1 into Phrase2 using addition, deletion, and substitution of characters
'Case insensitive
Dim str1() As String
Dim str2() As String
Dim dist() As Long
Dim lngLen1 As Long
Dim lngLen2 As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim a(2) As Long
Dim r As Long
Dim cost As Long
   lngLen1 = Len(phrase1)
   lngLen2 = Len(phrase2)
   ReDim str1(lngLen1)
   ReDim str2(lngLen2)
   ReDim dist(lngLen1, lngLen2)

   For i = 1 To lngLen1
       str1(i) = UCase$(Mid$(phrase1, i, 1))
   Next
   For i = 1 To lngLen2
       str2(i) = UCase$(Mid$(phrase2, i, 1))
   Next
   For i = 0 To lngLen1
       dist(i, 0) = i
   Next
   For j = 0 To lngLen2
       dist(0, j) = j
   Next
   For i = 1 To lngLen1
       For j = 1 To lngLen2
           If str1(i) = str2(j) Then
               cost = 0
           Else
               cost = 1
           End If
           a(0) = dist(i - 1, j) + 1             '' deletion
           a(1) = dist(i, j - 1) + 1             '' insertion
           a(2) = dist(i - 1, j - 1) + cost      '' substitution
           r = a(0)
           For k = 1 To UBound(a)
               If a(k) < r Then r = a(k)
           Next
           dist(i, j) = r
       Next
   Next
   LevenshteinDistance = dist(lngLen1, lngLen2)
End Function