Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


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

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
    Next
End Function

Francesco Balena
 
Comment and Contribute

 

 

 

 

 


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

 

 

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