Hi Wonderful People,
Here is my Problem.
Excel workbook 1 - List of User Accounts ( names are Misspelled or Abbreviated)
Excel Workbook 2 - List of All Employees we have ever hired. (Names are Correct)
I would like to compare the (Workbook1) UserAccount Name to All the Employee Names in (Workbook2). I wan to see which names in Workbook Two has the Highest Similarity Index using the Custom function below, And return me the match name based on that calculation.
I am using this code/Custom Function to Compare Two Text Strings. Which Works Wonderfully. - I just want to this in a Vlook Up.
I've used Fuzzy Merge in Power Query and played with the settings. Due to the differences in the Text , This calculation is more reliable for the remaining data.
Thank you
Eugene
Option Base 1
Function JaroWinklerProximity(string1 As Range, string2 As Range) As Double
Dim mWeightThreshold As Double
mWeightThreshold = 0.7
Dim mNumChars As Integer
mNumChars = 4
Dim aString1 As String
aString1 = LCase(string1.Text)
Dim aString2 As String
aString2 = LCase(string2.Text)
Dim lLen1 As Integer
lLen1 = Len(aString1)
Dim lLen2 As Integer
lLen2 = Len(aString2)
If lLen1 = 0 Then
If lLen2 = 0 Then
JaroWinklerProximity = 1
Exit Function
Else
JaroWinklerProximity = 0
Exit Function
End If
End If
Dim lSearchRange As Integer
lSearchRange = WorksheetFunction.Max(1, WorksheetFunction.Max(lLen1, lLen2) / 2)
ReDim lMatched1(lLen1) As Boolean
ReDim lMatched2(lLen2) As Boolean
Dim lNumCommon As Integer
lNumCommon = 0
Dim i As Integer
For i = 1 To lLen1 Step 1
Dim lStart As Integer
lStart = WorksheetFunction.Max(1, i - lSearchRange)
Dim lEnd As Integer
lEnd = WorksheetFunction.Min(i + lSearchRange, lLen2)
Dim j As Integer
For j = lStart To lEnd - 1 Step 1
If lMatched2(j) Then
GoTo NextIteration1
End If
Dim charAtIndex1 As String
charAtIndex1 = Mid(aString1, i, 1)
Dim charAtIndex2 As String
charAtIndex2 = Mid(aString2, j, 1)
If charAtIndex1 <> charAtIndex2 Then
GoTo NextIteration1
End If
lMatched1(i) = True
lMatched2(j) = True
lNumCommon = lNumCommon + 1
Exit For
NextIteration1:
Next j
Next i
If lNumCommon = 0 Then
JaroWinklerProximity = 0
Exit Function
End If
Dim lNumHalfTransposed As Integer
lNumHalfTransposed = 0
Dim k As Integer
k = 1
For i = 1 To lLen1 Step 1
If Not lMatched1(i) Then
GoTo NextIteration2
End If
Do While Not lMatched2(k)
k = k + 1
Loop
If Mid(aString1, i, 1) <> Mid(aString2, j, 1) Then
lNumHalfTransposed = lNumHalfTransposed + 1
End If
k = k + 1
NextIteration2:
Next
Dim lNumTransposed As Integer
lNumTransposed = lNumHalfTransposed / 2
Dim lNumCommonD As Double
lNumCommonD = lNumCommon
Dim lWeight As Double
lWeight = (lNumCommonD / lLen1 + lNumCommonD / lLen2 + (lNumCommon - lNumTransposed) / lNumCommonD) / 3
If lWeight <= mWeightThreshold Then
JaroWinklerProximity = lWeight
Exit Function
End If
Dim lMax As Integer
lMax = WorksheetFunction.Min(mNumChars, WorksheetFunction.Min(Len(aString1), Len(aString2)))
Dim lPos As Integer
lPos = 1
Do While lPos < lMax And Mid(aString1, lPos, 1) = Mid(aString2, lPos, 1)
lPos = lPos + 1
Loop
If lPos = 1 Then
JaroWinklerProximity = lWeight
Exit Function
End If
JaroWinklerProximity = lWeight + 0.1 * lPos * (1# - lWeight)
End Function
