I have been trying to create a search bar in Excel. I want to be able
to enter some letters into a cell, then have those letters be matched
with the closest resemblance in a range of text cells, and return the
number in the cell next to it. (I tried the LOOKUP functions, but if
the query is not exactly the same as the text in the array, it returns
the wrong value.)

Try the following subroutine & function. It finds the closest match within a
range of cells to the value in one particular cell. It returns (via MsgBox)
the address of the cell which is the closest match (or exact match, if it
finds one.)

Sub ClosestMatch()
Dim msg1 As String, R1 As Range, R2 As Range
Dim Closest As Range, EquivPct As Double
Dim CurrRecPct As Double
On Error GoTo CMerr1
EquivPct# = 0
'R1 is cell with text to match
Set R1 = Range("A1")
'R2 is current cell in selected range to search
Range("B5:M50").Select
For Each R2 In Selection
If R1.Value = R2.Value Then
MsgBox "Found exact match in cell " _
& R2.Address
GoTo Cleanup1
End If
CurrRecPct# = Equivalence(R1, R2)
If CurrRecPct# EquivPct# Then
EquivPct# = CurrRecPct#
Set Closest = R2
End If
Next R2
MsgBox "Closest match was cell " & _
Closest.Address
Cleanup1:
Set R1 = Nothing
Set Closest = Nothing
Exit Sub
CMerr1:
If Err.Number < 0 Then
msg1$ = "Error # " & Str(Err.Number) & _
" was generated by " & Err.Source & _
Chr(13) & Err.Description
MsgBox msg1$, , "ClosestMatch", _
Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Sub

Public Function Equivalence(Rng1 As Range, _
rng2 As Range) As Double
Dim MtchTbl(100, 100)
Dim MyMax As Double, ThisMax As Double
Dim i As Integer, j As Integer
Dim ii As Integer, jj As Integer
Dim st1 As String, st2 As String
If (Rng1.Count 1) Or (rng2.Count 1) Then
MsgBox "Arguments for Equivalence function " & _
"must be individual cells", vbExclamation, _
"Equivalence error"
Equivalence = -1
End If
st1$ = Trim(LCase(Rng1.Value))
st2$ = Trim(LCase(rng2.Value))
MyMax# = 0
For i% = Len(st1$) To 1 Step -1
For j% = Len(st2$) To 1 Step -1
If Mid(st1$, i%, 1) = Mid(st2$, j%, 1) Then
ThisMax# = 0
For ii% = (i% + 1) To Len(st1$)
For jj% = (j% + 1) To Len(st2$)
If MtchTbl(ii%, jj%) ThisMax# Then
ThisMax# = MtchTbl(ii%, jj%)
End If
Next jj%
Next ii%
MtchTbl(i%, j%) = ThisMax# + 1
If (ThisMax# + 1) ThisMax# Then
MyMax# = ThisMax# + 1
End If
End If
Next j%
Next i%
Equivalence# = MyMax# / ((Len(st1$) + Len(st2$)) / 2)
End Function

Hope this helps,

Hutch

"Haim" wrote:

I have been trying to create a search bar in Excel. I want to be able
to enter some letters into a cell, then have those letters be matched
with the closest resemblance in a range of text cells, and return the
number in the cell next to it. (I tried the LOOKUP functions, but if
the query is not exactly the same as the text in the array, it returns
the wrong value.)