search and display

[tkraju via OfficeKB.com]

I am looking for code that search a string,say first 3 letters of a
textboxvalue, from a range,and retuns all matching values in a searchresults
listbox.suppose user enters 'smi' in a inputbox all the valid serch results
in that range should populate in a list box.,say 'smith','smiron','smile',

 

[Bernie Deitrick]

TK,

You could use the change event of the textbox to constantly update the listbox... try the code
below. (Or you could use the code in a commandbutton.click event to update the list only when the
user is finished entering the search term.) Note that the search is done looking for the left-most
letters: you could also look for the string anywhere by changing

myFindString = strTBVAlue & "*"

to

myFindString = "*" & strTBVAlue & "*"

--
HTH,
Bernie
MS Excel MVP


Private Sub TextBox1_Change()
Dim c As Range ' The cell found with what you want
Dim d As Range ' All the cells found with what you want
Dim myFindString As String
Dim firstAddress As String
Dim strTBVAlue As String
Dim myCell As Range
Dim myArr() As String
Dim i As Integer

strTBVAlue = UserForm1.TextBox1.Text

myFindString = strTBVAlue & "*"

With Worksheets("Sheet1").Range("A:A")

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
Else:
ReDim myArr(1 To 1)
myArr(1) = ""
UserForm1.ListBox1.List = myArr
MsgBox "No cells found with that sub-string."
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address <> firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

i = 0
ReDim myArr(1 To d.Cells.Count)
For Each myCell In d
i = i + 1
myArr(i) = myCell.Value
Next myCell

UserForm1.ListBox1.List = myArr
End Sub