I'm writing a method that writes the code for a loading routine. Given an object from the database, I want to put its properties in the right control on a userform. I have the list of the properties and I have the names of the controls.
For each property, I want my code to search in the controls' name and find the most similar.
It doesn't have to be perfect, it's just something to avoid to rewrite the code over and over for every userform of each project. If it can guess 75%-80% it's ok.
I wrote the code below. The idea is:
- Check the presence of each character in the original string in each of the words in the list. If we are able to find it add 1 point to the score else subtract 1 point.
- Check if the position of the character is the same in both the words (+1/-1)
- Check if the closest characters - left and right - are the same (both match +1, 1 match 0, 0 match -1)
You can use the function as a worksheet one and you can see the scores in the immediate window.
The code does work. I mean, the results make sense.
Original string: michele
List to check: marta, elehcim, valerio, txtmichele, miche
Most similar according to the code: miche
Is this the most similar? How good developers approach this problem?
I'd like to have your opinion on the idea and if there is a better way to achieve the goal. The code is a mess but it's just a draft, doesn't matter at the moment.
Thank you for your time!
Public Function GetMostSimilar(toString As String, between As Variant) As String Dim i As Long Dim ch As String Dim o As Long Dim comparison As Variant Dim positionScore As Double Dim presenceScore As Double Dim am As ArrayManipulation Dim index As Long Dim bestScore As Double Dim bestComparison As String Dim closeCharatersScore As Double Dim score As Double ' range to array between = between.value Set am = New ArrayManipulation ' a low number bestScore = -1000 For o = LBound(between) To UBound(between) comparison = GetArrayOfCharacters(CStr(between(o, 1))) ' returns 1 based array positionScore = 0 presenceScore = 0 closeCharatersScore = 0 ' loop in characters For i = 1 To Len(toString) ch = Mid(toString, i, 1) ' array manipulation is an object to do stuff with arrays. In this case find the index of something in an array index = am.FindIndex(comparison, ch, 0, , False) ' method that check for match in left and right characters of the current character. +- 0.5 for each character depending if match closeCharatersScore = closeCharatersScore + GetCloseCharactersScore(CStr(between(o, 1)), index, toString, i) If index = -1 Then presenceScore = presenceScore - 1 positionScore = positionScore - 1 Else presenceScore = presenceScore + 1 positionScore = positionScore + IIf(i = index, 1, -1) comparison(index) = vbNullString End If Next i score = positionScore + presenceScore + closeCharatersScore Debug.Print between(o, 1) & ": " & score & "| POS: " & positionScore & " | Pres: " & presenceScore & " | Close: " & closeCharatersScore If score > bestScore Then bestScore = score bestComparison = between(o, 1) End If Next o GetMostSimilar = bestComparison End Function Private Function GetCloseCharactersScore(comparison As String, index As Long, toString As String, i As Long) As Double Dim leftOriginal As String Dim rightOriginal As String Dim leftComparison As String Dim rightComparison As String On Error Resume Next leftOriginal = Mid(toString, i - 1, 1) rightOriginal = Mid(toString, i + 1, 1) leftComparison = Mid(comparison, index - 1, 1) rightComparison = Mid(comparison, index + 1, 1) On Error GoTo 0 GetCloseCharactersScore = IIf(leftOriginal = leftComparison, 0.5, -0.5) + IIf(rightOriginal = rightComparison, 0.5, -0.5) End Function Private Function GetArrayOfCharacters(str As String) As Variant Dim i As Long ReDim temp(1 To Len(str)) As Variant For i = 1 To Len(str) temp(i) = Mid(str, i, 1) Next i GetArrayOfCharacters = temp End Function