Soundex is a phonetic algorithm for indexing names by sound. The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling. This article is about to implement fuzzy logic, that finding names that sound alike. In this article we are creating soundex function that will find the similar kind of words. MS access doesn’t have inbuilt function for soundex functionality but we can create own soundex function using VBA code. This function change the text value to a code combination.
Soundex takes the word and converts it to a 4 character string representation. The first letter will stay the same and then the other 3 letters represent the word without vowels. Soundex code is the first letter, followed by three numbers from assessment of the remaining letters. Vowels and Y,H,W are ignored. When consecutive letters return the same numerical code, the number appears only once. When two cards with the same code are separated only by H or W, the second letter is ignored. The letters are converted to numbers. If the final code after examining all letters is less than three digits, the code is padded with zeros.
To implement this need to create table, query ,Form and module. Table contains the data that we are find on the form and in query sql view we have to write similar query like:
SELECT tblPeople.PersonID, tblPeople.LastName, fSoundex([LastName]) AS Soundex, tblPeople.FirstName, tblPeople.MiddleName FROM tblPeople ORDER BY tblPeople.LastName;
After this we have create soundex function and call this function in after update event of search text box. After this we have to test this function , type word in search box and you will see in bellow list box all the similar sound like words are listing as shown in fig 1.1.
Fig:-1.1
VBA code on text box after_update event:
Option Compare Database Option Explicit Private Sub txtLastName_AfterUpdate() On Error GoTo ErrorHandler Dim txtSearchString As Variant Dim strSQL As String txtSearchString = Me![txtLastName] If Len(Me![txtLastName] & vbNullString) > 0 Then strSQL = "SELECT DISTINCTROW PersonID, LastName, FirstName, MiddleName FROM qryPeople WHERE Soundex = '" & fun_Soundex(txtSearchString) & "' ORDER BY LastName, FirstName" Else strSQL = "SELECT PersonID, LastName, FirstName, MiddleName FROM qryPeople WHERE LastName) Is Not Null ORDER BY LastName, FirstName" End If Me!lstResults.RowSource = strSQL Me!txtLastName.SetFocus Cleanup: Exit Sub ErrorHandler: MsgBox Err.Number & ": " & Err.Description Resume Cleanup End Sub
VBA code for Soundex function:
Option Compare Database Option Explicit Function fun_Soundex(ByVal StringValue As String) As String On Error GoTo ErrorHandler Dim sCurrVal As String Dim sInp As String Dim sPrev As String Dim sSndx As String Dim sIdx As Long Dim Linp As Long Dim sCurrChar As String sInp = UCase$(StringValue) Linp = Len(sInp) sSndx = Left(sInp, 1) sIdx = 1 Do While Len(sSndx) < 4 If sIdx > Linp Then sCurrVal = "0" sSndx = sSndx & sCurrVal Else sCurrChar = Mid$(sInp, sIdx, 1) Select Case sCurrChar Case "B", "F", "P", "V" sCurrVal = "1" Case "C", "G", "J", "K", "Q", "S", "X", "Z" sCurrVal = "2" Case "D", "T" sCurrVal = "3" Case "L" sCurrVal = "4" Case "M", "N" sCurrVal = "5" Case "R" sCurrVal = "6" Case Else 'A, E, I, O, U, H, W, Y or other sCurrVal = "0" End Select End If If (sCurrVal <> "0") Then If (sCurrVal <> sPrev) Then If sIdx <> 1 Then sSndx = sSndx & sCurrVal End If End If End If If sCurrChar <> "H" And sCurrChar <> "W" Then sPrev = sCurrVal End If sIdx = sIdx + 1 Loop Cleanup: fun_Soundex = sSndx Exit Function ErrorHandler: Err.Raise Err.Number, "fun_Soundex", Err.Description Resume Cleanup End Function
DISCLAIMER
It is advised that the information provided in the article should not be used for any kind formal or production programming purposes as content of the article may not be complete or well tested. ERP Makers will not be responsible for any kind of damage (monetary, time, personal or any other type) which may take place because of the usage of the content in the article.