The Secret of Soundex

Let's take a look at a Visual Basic algorithm that follows the rules set out on the previous page. The main function is called Soundex, which accepts any word and returns the four-letter Soundex code.

Here it is, commented and all:

Public Function Soundex(Word As String) As String    Dim strCode As StringDim strChar As StringDim lngWordLength As LongDim strLastCode As String' Grabs the first letterstrCode = UCase(Mid$(Word, 1, 1))strLastCode = GetSoundCodeNumber(strCode)' Stores the word lengthlngWordLength = Len(Word)' Continues the code, starting at the second letterFor i = 2 To lngWordLengthstrChar = GetSoundCodeNumber(UCase(Mid$ _                                    (Word, i, 1)))' If adjacent numbers are the same,' only count one of themIf Len(strChar) > 0 And strLastCode <> _           strChar Then strCode = strCode & strCharEnd IfstrLastCode = strCharNext' Trim it down to a maximum of four characters...Soundex = Mid$(strCode, 1, 4)' ... but if it's less than four characters, pad' it out with a bunch of zeros...If Len(strCode) < 4 ThenSoundex = Soundex & String(4 - Len(strCode), "0")End IfEnd FunctionPrivate Function GetSoundCodeNumber(Character As String) _        As String    ' Accepts a character and returns the' appropriate number from the Soundex tableSelect Case CharacterCase "B", "F", "P", "V"   GetSoundCodeNumber = "1"Case "C", "G", "J", "K", "Q", "S", "X", "Z"   GetSoundCodeNumber = "2"Case "D", "T"GetSoundCodeNumber = "3"Case "L"GetSoundCodeNumber = "4"Case "M", "N"GetSoundCodeNumber = "5"Case "R"GetSoundCodeNumber = "6"End SelectEnd Function

Page 4 of 6



This article was originally published on November 20, 2002