MS Access : still trouble with SoundEx

[SeeWard]

Good morning,
I used this code that was provided on the forums, but I am not sure how to implement it and make it work. When I run the query I come up with the codes rather than the records with quasi matching names.... Here's the code:

Public Function Sndx2(ParamArray WdList() As Variant) As String

'Rhyming Dictionary: PeterMecham
'By Michael Red: 11/16/2001

'? Sndx2("Red", "Michael")
'R3000M2400

'? Sndx2("Pfizer", "&", "Co.")
'F2600&0000C0000

'? sndx2("Bake", "Ache")
'B2000A2000

Dim LtrArray As String
Dim CodArray As String

Dim WdNum As Integer
Dim LtrNum As Integer
Dim LtrPos As Integer
Dim CodePos As Integer
Dim blnFirstLtr As Boolean

Dim SndCode As String
Dim CurCode As String
Dim LtrPr As String

LtrArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ'-,. /&" 'Letters/Symbols
CodArray = "012301200224550126230102020000000" 'Codes corresponding to Letters/Symbols

Const SndLen = 5

WdNum = 0 'Initalize WdList Pointer
Do While WdNum <= UBound(WdList) 'List of "Words" in input

tName = WdList(WdNum) 'Pick a "Word" to process

LtrPos = 1
Do While LtrPos <= Len(tName) 'Do whole Word

If (LtrPos = 1) Then 'Flag First Char/DipThong
blnFirstLtr = True 'So We Use the Alpha
End If

LtrPr = Mid(tName, LtrPos, 2) 'Get the Letter / Char PAIR
MyLtr = basDipThong(LtrPr) 'Check for DipThong

If (MyLtr = Mid(tName, LtrPos, 1)) Then 'Incr Letter pos in Word
LtrPos = LtrPos + 1 'Not Dipthong, One Char Processed
Else
LtrPos = LtrPos + 2 'DipThong, Processed 2 chars
End If

CodePos = InStr(LtrArray, MyLtr) 'Find alpha pos of letter
SndCod = Mid$(CodArray, CodePos, 1) 'Get the Letter Sound Code

If (blnFirstLtr = True) Then 'First "Char" (or Dip)
Sndx = Sndx & MyLtr 'Use the char
blnFirstLtr = False 'Set Flag OFF
Else
'Not First, Process as "Code"
If (CurrCode <> SndCod And SndCod <> 0) Then
Sndx = Sndx & SndCod
End If
End If

CurrCode = SndCod 'Prevent Double letter / Code
Loop 'LtrPos

'Below will "Pad" & "Trim" each Word to the Number of Chars Desired (e.g. 5)
Sndx = Sndx & String(SndLen, "0")
Sndx = Left$(Sndx, SndLen * (WdNum + 1))

WdNum = WdNum + 1
Loop 'WdNum

Sndx2 = Sndx

End Function
Public Function basDipThong(LtrPr As String) As String

Dim DipThongs As String
Dim RepChr As String
Dim PrCHrPos As Integer

DipThongs = "TS,TZ,GH,KN,PN,PH,PT,PF,PK" 'Dipthong Pairs
RepChr = "SZHNNFTFK" 'Dipthong Replacement Letters

Idx = InStr(DipThongs, UCase(LtrPr))
If (Idx <> 0) Then
PrCHrPos = (Idx + 2) / 3
basDipThong = Mid(RepChr, PrCHrPos, 1)
Else
basDipThong = Left(LtrPr, 1)
End If

End Function

---
Help please?

 

[benaround]

Though I am just starting down this road also and have just seen this post, I have a master database with names in it and data provided in an excel spreadsheet.
I was going to use this code to make a table, tbla, that has a these produced keys from the master database, then another,tblb, on the excel spreadsheet names. Finally I would compare the 2 tables by doing normal Access join operations and see what the matches look-like.

I have names like "ben around" that need to somehow match to "benarou". Hehe, that healthcare for you.

I'm not sure if this helps, but its where I'm headed.
If this works, I'll let you know.

 

[benaround]

I have just found a link that might help a great deal:

http://www.dhs.ca.gov/ps/ooa/HIVReporting/soundex/soundex.htm.

On this web page is a Microsoft Access db with code on using Soundex and an Excel spreadsheet with code on using soundex.
Good luck

 

[SeeWard]

Hi there and thanks for your post. I did get it to work, but what I did was to add extra fields to the table to accomodate a new field for the Soundex Code. I would then generate the SoundEx codes on the field I wanted (such as LastName) and save that code with the record. I then could do a comparison in a parameter query to pull up the desired records. It worked pretty well. Your post helped out a great deal as well..at least it gave me more options and ways to create such things.