Provided by Allen Browne, Nov 2007.  Last updated: Feb 2011.

Microsoft Access Tips for Serious Users

Soundex - Fuzzy matches

Soundex is a standard algorithm for finding names that sound alike. Access does not have a built-in Soundex function, but you can create one easily and use it inexact matches.

To use in your database:

1. Create a new module (from the Modules tab of the Database Window in Access 2003 or earlier, or the Create ribbon in Access 2007 and later.)
2. Paste in the code below.
3. To verify Access understands the code, choose Compile on the Debug menu.
4. Save the module with a name such as Module1.

You can now user the Soundex() function like any built-in function. The screenshot shows how to find the clients whose Surname matches the txtName box on Form1.

For background information on Soundex, and an explanation of how the algorithm works, see http://en.wikipedia.org/wiki/Soundex.

Update Feb 2011: Albert Kallal (MS Access MVP) has another version of Soundex for use in web forms (introduced in Access 2010. See A Soundex Search for Access Web services.

Public Function Soundex(varText As Variant) As Variant
On Error GoTo Err_Handler
    'Purpose:   Return Soundex value for the text passed in.
    'Return:    Soundex code, or Null for Error, Null or zero-length string.
    'Argument:  The value to generate the Soundex for.
    'Author:    Allen Browne (allen@allenbrowne.com), November 2007.
    'Algorithm: Based on http://en.wikipedia.org/wiki/Soundex
    Dim strSource As String     'varText as a string.
    Dim strOut As String        'Output string to build up.
    Dim strValue As String      'Value for current character.
    Dim strPriorValue As String 'Value for previous character.
    Dim lngPos As Long          'Position in source string
    
    'Do not process Error, Null, or zero-length strings.
    If Not IsError(varText) Then
        strSource = Trim$(Nz(varText, vbNullString))
        If strSource <> vbNullString Then
            'Retain the initial character, and process from 2nd.
            strOut = Left$(strSource, 1&)
            strPriorValue = SoundexValue(strOut)
            lngPos = 2&
            
            'Examine a character at a time, until we output 4 characters.
            Do
                strValue = SoundexValue(Mid$(strSource, lngPos, 1&))
                'Omit repeating values (except the zero for padding.)
                If ((strValue <> strPriorValue) And (strValue <> vbNullString)) Or (strValue = "0") Then
                    strOut = strOut & strValue
                    strPriorValue = strValue
                End If
                lngPos = lngPos + 1&
            Loop Until Len(strOut) >= 4&
        End If
    End If
    
    'Return the output string, or Null if nothing generated.
    If strOut <> vbNullString Then
        Soundex = strOut
    Else
        Soundex = Null
    End If
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Soundex()"
    'Call LogError(Err.Number, Err.Description, conMod & ".Soundex")
    Resume Exit_Handler
End Function
Private Function SoundexValue(strChar As String) As String
    Select Case strChar
    Case "B", "F", "P", "V"
        SoundexValue = "1"
    Case "C", "G", "J", "K", "Q", "S", "X", "Z"
        SoundexValue = "2"
    Case "D", "T"
        SoundexValue = "3"
    Case "L"
        SoundexValue = "4"
    Case "M", "N"
        SoundexValue = "5"
    Case "R"
        SoundexValue = "6"
    Case vbNullString
        'Pad trailing zeros if no more characters.
        SoundexValue = "0"
    Case Else
        'Return nothing for "A", "E", "H", "I", "O", "U", "W", "Y", non-alpha.
    End Select
End Function