Cacher is the code snippet organizer for pro developers

Public Function String_FuzzyMatch(ByVal a As String, ByVal b As String, removeSpaces As Boolean) As Double

   If removeSpaces Then
      a=Replace(a," ","")
      b=Replace(b," ","")
   End If

   Dim length As Integer
   length=Long_Max(Len(a),Len(b))

   If length = 0 Then Return 0

   Dim distance As Integer
   distance=String_LevenshteinDistance(a, b)
   Return CDbl(1.0 - (distance / length)^2)
End Function

Public Function String_LevenshteinDistance(a As String ,b As String) As Integer
   'http://en.wikipedia.org/wiki/Levenshtein_distance
   'Levenshtein distance between two strings, used for fuzzy matching
   Dim i,j,cost,d,ins,del,subs As Integer

   If Len(a) = 0 Then Return Len(b)
   If Len(b) = 0 Then Return Len(a)

   ReDim d(Len(a), Len(b))
   For i = 0 To Len(a)
      d(i, 0) = i
   Next
   For j = 0 To Len(b)
      d(0, j) = j
   Next
   For i = 1 To Len(a)
     For j = 1 To Len(b)
         If Mid(a, i, 1) = Mid(b, j, 1) Then cost = 0 Else cost = 1   ' cost of substitution

         del = ( d( i - 1, j ) + 1 ) ' cost of deletion
         ins = ( d( i, j - 1 ) + 1 ) ' cost of insertion
         subs = ( d( i - 1, j - 1 ) + cost ) 'cost of substition or match
         d(i,j)=Long_Min(ins,Long_Min(del,subs))
      Next
   Next
   Return d(Len(a), Len(b))
End Function

Public Function Long_Max(v1 As Long, v2 As Long) As Long
   If v1 > v2 Then Return v1 Else Return v2
End Function

Public Function Long_Min(v1 As Long, v2 As Long) As Long
   If v1 < v2 Then Return v1 Else Return v2
End Function


      Case "btnFuzzyMatch"

         Dim a, b As String
         a = InputBox("Value 1")
         b = InputBox("Value 2")
         MsgBox CStr(String_FuzzyMatch(a, b, True))