Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Feb 26, 2000



Building the Right Environment to Support AI, Machine Learning and Deep Learning

Soundex - Determine the phonetic code of a word

' The Soundex code of an alphabetical string
' you can use Soundex code for phonetic searches
' Beware: this isn't bullet-proof!
' UPDATE: this version corrects a bug in the original routine
'         thanks to Edward Wittke for spotting the mistake

Function Soundex(ByVal word As String) As String
    Dim result As String
    Dim i As Long, acode As Integer
    Dim dcode As Integer, oldCode As Integer
    ' soundex is case-insensitive
    word = UCase$(word)
    ' the first letter is copied in the result
    Soundex = Left$(word, 1)
    oldCode = Asc(Mid$("01230120022455012623010202", Asc(word) - 64))
    For i = 2 To Len(word)
        acode = Asc(Mid$(word, i, 1)) - 64
        ' discard non-alphabetic chars
        If acode >= 1 And acode <= 26 Then
            ' convert to a digit
            dcode = Asc(Mid$("01230120022455012623010202", acode, 1))
            ' don't insert repeated digits
            If dcode <> 48 And dcode <> oldCode Then
                Soundex = Soundex & Chr$(dcode)
                If Len(Soundex) = 4 Then Exit For
            End If
            oldCode = dcode
        End If
End Function

Francesco Balena
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date