Skip to main content

SoundEx

IDEA already has a function that performs the soundex function which is the @Soundex function that is defined as "Determine whether text is similar in sound. It returns a code which can be used for comparisons."  I found at http://rosettacode.org/wiki/Soundex#VBScript an algorithm for the soundex.  I adapted the original a bit and created a custom function.  Now the custom function should give exactly the same results as the @Soundex function but sometimes it is fun to know how things work.  So below is the code that is used for the Soundex function and I have attached the custom function for anyone that wants to try it out.

Option Explicit
Function SoundEx(p1 As String) As String

    Dim code As String
    Dim previous As Integer
    Dim i As Integer
    Dim current As String
    code = UCase(Mid(p1, 1, 1))
    previous = 7
    For i = 2 To (Len(p1) + 1)
        current = getCode(UCase(Mid(p1, i, 1)))
        If Len(current) > 0 And current <> previous Then
            code = code & current
        End If
        previous = current
    Next
    soundex = Mid(code, 1, 4)
    If Len(code) < 4 Then
        soundex = soundex & String(4 - Len(code), "0")
    End If
End Function

Function getCode(c)
    Select Case c
        Case "B", "F", "P", "V"
            getCode = "1"
        Case "C", "G", "J", "K", "Q", "S", "X", "Z"
            getCode = "2"
        Case "D", "T"
            getCode = "3"
        Case "L"
            getCode = "4"
        Case "M", "N"
            getCode = "5"
        Case "R"
            getCode = "6"
    End Select
End Function