Soundex

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

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