Attribute VB_Name = "modLevenshtein"
Option Explicit
'Option Base 0 assumed

'LevenshteinS 7925 ms
'LevenshteinB 592 ms

Sub testLevenshtein()
Dim s1 As String, s2 As String, lTime As Long, i As Long
s1 = String(100, "x")
s2 = String(100, "a")
lTime = GetTickCount()
For i = 1 To 100
   LevenshteinS s1, s2  ' the original fn from Wikibooks and Stackoverflow
Next
Debug.Print GetTickCount - lTime; " ms" '  3900  ms for all diff

lTime = GetTickCount
For i = 1 To 100
   LevenshteinB s1, s2
Next
Debug.Print GetTickCount - lTime; " ms" ' 234  ms
End Sub


'http://en.wikibooks.org/wiki/Algorithm_Implementation/Strings/Levenshtein_distance#Visual_Basic_for_Applications_.28no_Damerau_extension.29

Function LevenshteinS(ByVal string1 As String, ByVal string2 As String) As Long
 
Dim i As Long, j As Long
Dim string1_length As Long
Dim string2_length As Long
Dim distance() As Long
Dim min1 As Long, min2 As Long, min3 As Long
Const UseWSMIN = False
 
string1_length = Len(string1)
string2_length = Len(string2)
ReDim distance(string1_length, string2_length)
 
For i = 0 To string1_length
    distance(i, 0) = i
Next
 
For j = 0 To string2_length
    distance(0, j) = j
Next
 
For i = 1 To string1_length
    For j = 1 To string2_length
        If Mid$(string1, i, 1) = Mid$(string2, j, 1) Then
            distance(i, j) = distance(i - 1, j - 1)
        Else
          If UseWSMIN Then
            distance(i, j) = WorksheetFunction.Min _
            (distance(i - 1, j) + 1, _
             distance(i, j - 1) + 1, _
             distance(i - 1, j - 1) + 1)
          Else
            ' spell it out, 50 times faster than worksheetfunction.min
            min1 = distance(i - 1, j) + 1
            min2 = distance(i, j - 1) + 1
            min3 = distance(i - 1, j - 1) + 1
            If min1 <= min2 And min1 <= min3 Then
                distance(i, j) = min1
            ElseIf min2 <= min1 And min2 <= min3 Then
                distance(i, j) = min2
            Else
                distance(i, j) = min3
            End If
          End If
        End If
    Next
Next
 
LevenshteinS = distance(string1_length, string2_length)
 
End Function



'POB: fn with byte array and inline MIN code is 17 times faster
Function LevenshteinB(ByVal string1 As String, ByVal string2 As String) As Long
Dim i As Long, j As Long, ByteArray1() As Byte, ByteArray2() As Byte
Dim string1_length As Long
Dim string2_length As Long
Dim distance() As Long
Dim min1 As Long, min2 As Long, min3 As Long
Const UseWSMIN = False

string1_length = Len(string1)
string2_length = Len(string2)
ReDim distance(string1_length, string2_length)
ByteArray1 = string1
ByteArray2 = string2

For i = 0 To string1_length
    distance(i, 0) = i
Next
 
For j = 0 To string2_length
    distance(0, j) = j
Next
 
For i = 1 To string1_length
    For j = 1 To string2_length
        'Unicode, compare both even and odd bytes
        If ByteArray1((i - 1) * 2) = ByteArray2((j - 1) * 2) And _
            ByteArray1((i - 1) * 2 + 1) = ByteArray2((j - 1) * 2 + 1) Then
            distance(i, j) = distance(i - 1, j - 1)
        Else
          If UseWSMIN Then
            distance(i, j) = WorksheetFunction.Min _
            (distance(i - 1, j) + 1, _
             distance(i, j - 1) + 1, _
             distance(i - 1, j - 1) + 1)
          Else
            ' spell it out, 50 times faster than worksheetfunction.min
            min1 = distance(i - 1, j) + 1
            min2 = distance(i, j - 1) + 1
            min3 = distance(i - 1, j - 1) + 1
            If min1 <= min2 And min1 <= min3 Then
                distance(i, j) = min1
            ElseIf min2 <= min1 And min2 <= min3 Then
                distance(i, j) = min2
            Else
                distance(i, j) = min3
            End If
          End If
        End If
    Next
Next
 
LevenshteinB = distance(string1_length, string2_length)
 
End Function