vb Code:
Private Function Soundex(argWord As String)
Dim workStr As String, i As Long
'// Capitalize it to remove ambiguity
argWord = UCase$(argWord)
'// 1. Retain the first letter of the string
workStr = Left$(argWord, 1)
'// 2. Replacement
' [a, e, h, i, o, u, w, y] = 0
' [b, f, p, v] = 1
' [c, g, j, k, q, s, x, z] = 2
' [d, t] = 3
' [l] = 4
' [m, n] = 5
' [r] = 6
For i = 2 To Len(argWord)
Select Case Mid$(argWord, i, 1)
Case "B", "F", "P", "V"
workStr = workStr & Chr$(49) '// 1
Case "C", "G", "J", "K", "Q", "S", "X", "Z"
workStr = workStr & Chr$(50) '// 2
Case "D", "T"
workStr = workStr & Chr$(51) '// 3
Case "L"
workStr = workStr & Chr$(52) '// 4
Case "M", "N"
workStr = workStr & Chr$(53) '// 5
Case "R"
workStr = workStr & Chr$(56) '// 6
'// A, E, H, I, O, U, W, Y do nothing
End Select
Next i
'// 5. Return the first four bytes padded with 0
'fix: for long string compatible, do not return only the first four bytes, but all of them
'fix2: removed padding, seemed like it did not make any difference to the GetLevenshteinDistance function
Soundex = workStr
End Function
vb Code:
Dim cP As New clsPhoneme
Dim subStr(1) As String
subStr(0) = cP.GetSoundexWord("electromagnet")
subStr(1) = cP.GetSoundexWord("electromagnetic")
Debug.Print subStr(0), subStr(1)
Debug.Print cP.GetLevenshteinDistance(subStr(0), subStr(1)) 'should return 1 if you used my modified Soundex function, otherwise it'll be zero
Set cP = Nothing