• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Visual Basic SoundEx function

Status
Not open for further replies.

Kaway

Banned
User
Joined
Aug 7, 2014
Messages
720
Reputation
0
Reaction score
5,766
Points
243
Credits
0
‎10 Years of Service‎
15%
Please note, if you want to make a deal with this user, that it is blocked.
[HIDE-THANKS]This SoundEx function uses standard VB functions to return a code which is identical to the Oracle SoundEx() function.

Code:
>Private Function SoundEx(ByVal WordString As String, _
  Optional SoundExLen As Integer = 4) As String

Dim Counter As Integer
Dim CurrChar As String

If SoundExLen > 10 Then
   SoundExLen = 10
ElseIf SoundExLen < 4 Then
   SoundExLen = 4
End If
SoundExLen = SoundExLen - 1

WordString = UCase(WordString)

For Counter = 1 To Len(WordString)
   If Asc(Mid(WordString, Counter, 1)) < 65 Or Asc(Mid(WordString, Counter, 1)) > 90 Then
      Mid(WordString, Counter, 1) = " "
   End If
Next Counter
WordString = Trim(WordString)

SoundEx = WordString

SoundEx = Replace(SoundEx, "A", "0")
SoundEx = Replace(SoundEx, "E", "0")
SoundEx = Replace(SoundEx, "I", "0")
SoundEx = Replace(SoundEx, "O", "0")
SoundEx = Replace(SoundEx, "U", "0")
SoundEx = Replace(SoundEx, "Y", "0")
SoundEx = Replace(SoundEx, "H", "0")
SoundEx = Replace(SoundEx, "W", "0")
SoundEx = Replace(SoundEx, "B", "1")
SoundEx = Replace(SoundEx, "P", "1")
SoundEx = Replace(SoundEx, "F", "1")
SoundEx = Replace(SoundEx, "V", "1")
SoundEx = Replace(SoundEx, "C", "2")
SoundEx = Replace(SoundEx, "S", "2")
SoundEx = Replace(SoundEx, "G", "2")
SoundEx = Replace(SoundEx, "J", "2")
SoundEx = Replace(SoundEx, "K", "2")
SoundEx = Replace(SoundEx, "Q", "2")
SoundEx = Replace(SoundEx, "X", "2")
SoundEx = Replace(SoundEx, "Z", "2")
SoundEx = Replace(SoundEx, "D", "3")
SoundEx = Replace(SoundEx, "T", "3")
SoundEx = Replace(SoundEx, "L", "4")
SoundEx = Replace(SoundEx, "M", "5")
SoundEx = Replace(SoundEx, "N", "5")
SoundEx = Replace(SoundEx, "R", "6")

CurrChar = Left(SoundEx, 1)
For Counter = 2 To Len(SoundEx)
   If Mid(SoundEx, Counter, 1) = CurrChar Then
       Mid(SoundEx, Counter, 1) = " "
   Else
       CurrChar = Mid(SoundEx, Counter, 1)
   End If
Next Counter
SoundEx = Replace(SoundEx, " ", "")

SoundEx = Mid(SoundEx, 2)
SoundEx = Replace(SoundEx, "0", "")

SoundEx = SoundEx & String(SoundExLen, "0")
SoundEx = Left(WordString, 1) & Left(SoundEx, SoundExLen)
End Function
[/HIDE-THANKS]

 
Status
Not open for further replies.
Back
Top