Untitled

Function fuzzy_search(searchStr As String, lookupFields As range) As Variant
Dim r As Object
Dim r2 As Object
Dim i As Integer
Dim searchRange As range
Dim patternStr As String
Dim curPatternStr As String

fuzzy_search = "Í/Ä"

Set r = CreateObject("vbscript.regexp")
With r
      .Global = True
      .IgnoreCase = True
      .Pattern = "([a-zà-ÿ0-9_]+)"
End With

Set r2 = CreateObject("vbscript.regexp")
With r2
      .Global = True
      .IgnoreCase = True
      .Pattern = "[^a-zà-ÿ0-9_]"
End With

Set searchMatches = r.Execute(Trim(searchStr))

Dim m1 As Object
Dim m2 As Object

Dim max As Integer
Dim currentMax As range
Dim tmp As String
max = 0
For Each searchRange In lookupFields
    If LCase(r2.Replace(searchRange, "")) Like LCase(r2.Replace(searchStr, "")) Then
        Set currentMax = searchRange
        Exit For
    End If

    tmp = ""
    'MsgBox r2.Replace(searchRange, "*")
    Set searchMatches2 = r.Execute(Trim(searchRange))
    i = 0
    For Each m2 In searchMatches2
        'MsgBox Len(m2.SubMatches())
        For Each m1 In searchMatches
            If LCase(m1.Value) Like LCase(m2.Value) Then
                If Len(m2.Value) > 1 Then
                    i = i + 1
                    'MsgBox m1.Value & " " & i
                End If
            End If
        Next
    Next

    For Each m2 In searchMatches2
        tmp = tmp + m2.Value
        For Each m1 In searchMatches
            If LCase(m1.Value) Like LCase(tmp) Then
                If Len(tmp) > 1 Then
                    i = i + 1
                    'MsgBox m1.Value & " " & i
                End If
            End If
        Next
    Next

    'For i = 98 To 9 Step -1
'do stuff eg: If Cells(i,"B").Value = "X" Then ....
'Next i

    'MsgBox i

    If i > max Then
        'MsgBox i
        max = i
        Set currentMax = searchRange
    End If
Next

fuzzy_search = currentMax
'patternStr = r.Replace(Trim(searchStr), "*")
'curPatternStr = patternStr
'For i = 0 To Len(curPatternStr)
'    curPatternStr = Left(curPatternStr, Len(curPatternStr) - i)
'    MsgBox curPatternStr
'    For Each searchRange In lookupFields
'        If searchRange Like curPatternStr Then fuzzy_search = searchRange: Exit Function
'    Next
'Next

End Function