Soundex Function

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi

I'd like to know if there is something similar to Sql Server function
soundex() in Access ?
 
A SoundEx function converts a string to a number, with the premise that two
numbers close together are derived from strings that sound alike. Access
does not have a built-in function to do this, unlike SQL Server.


Function Soundex (ByVal S As String) As String
S = UCase$(Trim$(S))
Dim Code As Integer: Code = 0
Dim Last As Integer: Last = 0
Dim R As String: R = ""
Dim i As Long: For i = 1 To Len(S)
Select Case Mid$(S, i, 1)
Case "B", "F", "P", "V"
Code = 1
Case "C", "G", "J", "K", "Q", "S", "X", "Z"
Code = 2
Case "D", "T"
Code = 3
Case "L"
Code = 4
Case "M", "N"
Code = 5
Case "R"
Code = 6
Case Else
Code = 0
End Select
If (i = 1) Then
R = Mid$(S, 1, 1)
ElseIf (Code <> 0 And Code <> Last) Then
R = R & Code
End If
Last = Code
Next i
Soundex = Mid$(R & "0000", 1, 4)
End Function
 
This implements a slightly simplified version of the full Soundex
code algorithm, and returns a result which will work well for most
purposes for which a Soundex code is used. The full algorithm treats H
and W as if they did not exist - similar sounding letters separated
only by H or W are treated as _adjacent_ and the second one is not
coded. This Function treats H and W as vowels, so that both the
surrounding letters are coded.

For the real pedant, the original version of the algorithm also
provided that, if a name had a prefix such as Van, Con, De, Di, La, or
Le, it should be coded both with and without the prefix, because the
surname might be listed under either code. However, Mc, Mac, and O'
were always considered to be integral parts of names starting with
them, rather than prefixes.


A SoundEx function converts a string to a number, with the premise that two
numbers close together are derived from strings that sound alike. Access
does not have a built-in function to do this, unlike SQL Server.


Function Soundex (ByVal S As String) As String
S = UCase$(Trim$(S))
Dim Code As Integer: Code = 0
Dim Last As Integer: Last = 0
Dim R As String: R = ""
Dim i As Long: For i = 1 To Len(S)
Select Case Mid$(S, i, 1)
Case "B", "F", "P", "V"
Code = 1
Case "C", "G", "J", "K", "Q", "S", "X", "Z"
Code = 2
Case "D", "T"
Code = 3
Case "L"
Code = 4
Case "M", "N"
Code = 5
Case "R"
Code = 6
Case Else
Code = 0
End Select
If (i = 1) Then
R = Mid$(S, 1, 1)
ElseIf (Code <> 0 And Code <> Last) Then
R = R & Code
End If
Last = Code
Next i
Soundex = Mid$(R & "0000", 1, 4)
End Function


Please respond to the Newsgroup, so that others may benefit from the exchange.
Peter R. Fletcher
 
Back
Top