Looking for a faster performance...of Damon Ostrander's code.
str1 is limited to 24 characters max since the algorithm takes a bit of time (it's exhaustive in it's comparison against ordered combinations).
I need help with augmenting the code to reflect if a match is found that it does not need to carry out the process of checking other characters on the character of str1, it can instead move on to the next character).Thanks for your help.
str1 is limited to 24 characters max since the algorithm takes a bit of time (it's exhaustive in it's comparison against ordered combinations).
I need help with augmenting the code to reflect if a match is found that it does not need to carry out the process of checking other characters on the character of str1, it can instead move on to the next character).Thanks for your help.
Code:
Dim TopMatch As Integer
Dim strCompare As String
Function Fuzzy(strIn1 As String, strIn2 As String) As Single
Dim L1 As Integer
Dim In1Mask(1 To 24) As Long 'strIn1 is 24 characters max
Dim iCh As Integer
Dim N As Long
Dim strTry As String
Dim strTest As String
TopMatch = 0
L1 = Len(strIn1)
strTest = UCase(strIn1)
strCompare = UCase(strIn2)
For iCh = 1 To L1
In1Mask(iCh) = 2 ^ iCh
Next iCh
'Loop thru all ordered combinations of characters in strIn1
For N = 2 ^ (L1 + 1) - 1 To 1 Step -1
strTry = ""
For iCh = 1 To L1
If In1Mask(iCh) And N Then
strTry = strTry & Mid(strTest, iCh, 1)
End If
Next iCh
If Len(strTry) > TopMatch Then TestString strTry
Next N
Fuzzy = TopMatch / CSng(L1)
End Function
Sub TestString(strIn As String)
Dim L As Integer
Dim strTry As String
Dim iCh As Integer
L = Len(strIn)
If L <= TopMatch Then Exit Sub
strTry = "*"
For iCh = 1 To L
strTry = strTry & Mid(strIn, iCh, 1) & "*"
Next iCh
If strCompare Like strTry Then
If L > TopMatch Then TopMatch = L
End If
End Sub