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 mistakeFunction 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    NextEnd Function

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: