It’s a simple fix (see red below).

Function Soundex(strName As String) As String
‘———————————————————–
‘ Input: A string
‘ Outputs: U.S. National archive “Soundex” number
‘   This number is useful to find similar last names
‘ Created By: JLV 03/01/2003
‘ Last Revised: JLV 06/27/2005
‘———————————————————–
‘ A Soundex code is the first letter, followed by
‘ three numbers derived from evaluating the remaining
‘ letters.  Vowels (including Y) and the letters H and W
‘ are ignored.  When consecutive letters return the
‘ same numeric code, the number appears only once.
‘ When two letters with the same code are separated only
‘ by H or W, the second letter is ignored.
‘ Letters are translated to numbers as follows:
‘   B, P, F, V = 1
‘   C, S, G, J, K, Q, X, Z = 2
‘   D, T = 3
‘   L = 4
‘   M, N = 5
‘   R = 6
‘ If the final code after examining all letters is less
‘ than three digits, the code is padded with zeros.
‘ Working variables:
‘ String to build the code, string to hold code number
Dim strCode As String, strCodeN As String
‘ Length of original string, last code returned, looping integer
Dim intLength As Integer, strLastCode As String, intI As Integer
‘ Save the first letter
strCode = UCase(Left(strName, 1))
‘ Save its code number to check for duplicates
strLastCode = GetSoundexCode(strCode)
‘ Calculate length to examine
intLength = Len(strName)
‘ Create the code starting at the second letter.
For intI = 2 To intLength
   strCodeN = GetSoundexCode(Mid(strName, intI, 1))
   ‘ If two letters that are the same are next to each other
   ‘ only count one of them
   If strCodeN > “0″ And strLastCode <> strCodeN Then
     ‘ Different code number, add to the result
     strCode = strCode & strCodeN
   End If
   ‘ If this is not the special “skip” code (H or W)
   If strCodeN <> “0″ Then
     ‘ Save the last code number
     strLastCode = strCodeN
   End If
‘ Loop
Next intI
‘ Check the length
If Len(strCode) < 4 Then
   ‘ Pad zeros
   strCode = strCode & String(4 – Len(strCode), “0″)
Else
   ‘ Make sure not more than 4
   strCode = Left(strCode, 4)
End If
‘ Return the result
Soundex = strCode
End Function

Private Function GetSoundexCode(strCharString) As String
‘———————————————————–
‘ Input: One character
‘ Output: U.S. National archive “Soundex” number
‘   for the specified letter
‘ Created By: JLV 03/01/2003
‘ Last Revised: ZHM 04/21/2008
‘   – Fixed error in variable names
‘———————————————————–
Select Case strCharString
   Case “B”, “F”, “P”, “V”
    GetSoundexCode = “1″
   Case “C”, “G”, “J”, “K”, “Q”, “S”, “X”, “Z”
     GetSoundexCode = “2″
   Case “D”, “T”
     GetSoundexCode = “3″
   Case “L”
     GetSoundexCode = “4″
   Case “M”, “N”
     GetSoundexCode = “5″
   Case “R”
     GetSoundexCode = “6″
   Case “H”, “W”
     ‘ Special “skip” code
     GetSoundexCode = “0″
End Select
End Function

Share/Save