VBA listbox search

C

chunu

Board Regular
Joined
Jul 5, 2012
Messages
101
Office Version
  1. 2013
Platform
  1. Windows
  2. Mobile
Hi,
can some one help me to add search option in user form(search as you type)
here is the code
Code: 
Private Sub cmdadd_Click()
Dim addme As Range
    Dim x As Integer
    Set addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then
            addme = Me.lstSelector.List(x)
            addme.Offset(0, 1) = Me.lstSelector.List(x, 1)
            addme.Offset(0, 2) = Me.lstSelector.List(x, 2)
            addme.Offset(0, 3) = Me.lstSelector.List(x, 3)
            addme.Offset(0, 4) = Me.lstSelector.List(x, 4)
            addme.Offset(0, 5) = Me.lstSelector.List(x, 5)
            Set addme = addme.Offset(1, 0)
        End If
    Next x
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then Me.lstSelector.Selected(x) = False
    Next x
End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
Assuming a Text Box on the user form in which you start typing a last name...

Add a text box to your user form
Highlight Select the data on "Staff List", C6:H31 and from the Home Ribbon > Format as Table

Try this for the user form code
Code: 
Option Explicit
    Dim oLo As ListObject


Private Sub cmdadd_Click()
Dim addme As Range
    Dim x As Integer
    Set addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then
            addme = Me.lstSelector.List(x)
            addme.Offset(0, 1) = Me.lstSelector.List(x, 1)
            addme.Offset(0, 2) = Me.lstSelector.List(x, 2)
            addme.Offset(0, 3) = Me.lstSelector.List(x, 3)
            addme.Offset(0, 4) = Me.lstSelector.List(x, 4)
            addme.Offset(0, 5) = Me.lstSelector.List(x, 5)
            Set addme = addme.Offset(1, 0)
        End If
    Next x
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then Me.lstSelector.Selected(x) = False
    Next x
End Sub


Private Sub TextBox1_Change()
    Dim cel As Range, n As Integer
If Me.TextBox1 = "" Then
    Me.lstSelector.List = oLo.DataBodyRange.Value
Else
    'clear existing list
    Me.lstSelector.Clear
    'filter last names
    oLo.Range.AutoFilter field:=3, Criteria1:=Me.TextBox1 & "*"
    'check result not empty
    If Application.WorksheetFunction.CountA(oLo.Range.Columns(1).SpecialCells(xlCellTypeVisible)) = 1 Then
        Exit Sub
    Else
        'load only visible data
        For Each cel In oLo.DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible)
            With Me.lstSelector
                .AddItem cel.Value
                For n = 1 To 5
                    .List(.ListCount - 1, n) = cel.Offset(, n).Value
                Next n
            End With
        Next cel
    End If
End If
End Sub


Private Sub UserForm_Initialize()
    Set oLo = Sheet2.ListObjects(1)
    Me.lstSelector.List = oLo.DataBodyRange.Value
    Me.TextBox1.SetFocus
End Sub


Private Sub UserForm_Terminate()
    oLo.Range.AutoFilter
End Sub
 
Upvote 0
NoSparks said:
Assuming a Text Box on the user form in which you start typing a last name...

Add a text box to your user form
Highlight Select the data on "Staff List", C6:H31 and from the Home Ribbon > Format as Table

Try this for the user form code
Code: 
Option Explicit
    Dim oLo As ListObject


Private Sub cmdadd_Click()
Dim addme As Range
    Dim x As Integer
    Set addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then
            addme = Me.lstSelector.List(x)
            addme.Offset(0, 1) = Me.lstSelector.List(x, 1)
            addme.Offset(0, 2) = Me.lstSelector.List(x, 2)
            addme.Offset(0, 3) = Me.lstSelector.List(x, 3)
            addme.Offset(0, 4) = Me.lstSelector.List(x, 4)
            addme.Offset(0, 5) = Me.lstSelector.List(x, 5)
            Set addme = addme.Offset(1, 0)
        End If
    Next x
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then Me.lstSelector.Selected(x) = False
    Next x
End Sub


Private Sub TextBox1_Change()
    Dim cel As Range, n As Integer
If Me.TextBox1 = "" Then
    Me.lstSelector.List = oLo.DataBodyRange.Value
Else
    'clear existing list
    Me.lstSelector.Clear
    'filter last names
    oLo.Range.AutoFilter field:=3, Criteria1:=Me.TextBox1 & "*"
    'check result not empty
    If Application.WorksheetFunction.CountA(oLo.Range.Columns(1).SpecialCells(xlCellTypeVisible)) = 1 Then
        Exit Sub
    Else
        'load only visible data
        For Each cel In oLo.DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible)
            With Me.lstSelector
                .AddItem cel.Value
                For n = 1 To 5
                    .List(.ListCount - 1, n) = cel.Offset(, n).Value
                Next n
            End With
        Next cel
    End If
End If
End Sub


Private Sub UserForm_Initialize()
    Set oLo = Sheet2.ListObjects(1)
    Me.lstSelector.List = oLo.DataBodyRange.Value
    Me.TextBox1.SetFocus
End Sub


Private Sub UserForm_Terminate()
    oLo.Range.AutoFilter
End Sub
Click to expand...

Hi,
Thank you very much for reply. after applying you code when i click to open user form, message appear( run-time error '70': permission denied)
please help
Thanks
 
Upvote 0
Oops... missed a step.

In Listbox properties, remove the Rowsource (trades), this will allow the code to look after things.
 
Upvote 0
NoSparks said:
Assuming a Text Box on the user form in which you start typing a last name...

Add a text box to your user form
Highlight Select the data on "Staff List", C6:H31 and from the Home Ribbon > Format as Table

Try this for the user form code
Code: 
Option Explicit
    Dim oLo As ListObject


Private Sub cmdadd_Click()
Dim addme As Range
    Dim x As Integer
    Set addme = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then
            addme = Me.lstSelector.List(x)
            addme.Offset(0, 1) = Me.lstSelector.List(x, 1)
            addme.Offset(0, 2) = Me.lstSelector.List(x, 2)
            addme.Offset(0, 3) = Me.lstSelector.List(x, 3)
            addme.Offset(0, 4) = Me.lstSelector.List(x, 4)
            addme.Offset(0, 5) = Me.lstSelector.List(x, 5)
            Set addme = addme.Offset(1, 0)
        End If
    Next x
    For x = 0 To Me.lstSelector.ListCount - 1
        If Me.lstSelector.Selected(x) Then Me.lstSelector.Selected(x) = False
    Next x
End Sub


Private Sub TextBox1_Change()
    Dim cel As Range, n As Integer
If Me.TextBox1 = "" Then
    Me.lstSelector.List = oLo.DataBodyRange.Value
Else
    'clear existing list
    Me.lstSelector.Clear
    'filter last names
    oLo.Range.AutoFilter field:=3, Criteria1:=Me.TextBox1 & "*"
    'check result not empty
    If Application.WorksheetFunction.CountA(oLo.Range.Columns(1).SpecialCells(xlCellTypeVisible)) = 1 Then
        Exit Sub
    Else
        'load only visible data
        For Each cel In oLo.DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible)
            With Me.lstSelector
                .AddItem cel.Value
                For n = 1 To 5
                    .List(.ListCount - 1, n) = cel.Offset(, n).Value
                Next n
            End With
        Next cel
    End If
End If
End Sub


Private Sub UserForm_Initialize()
    Set oLo = Sheet2.ListObjects(1)
    Me.lstSelector.List = oLo.DataBodyRange.Value
    Me.TextBox1.SetFocus
End Sub


Private Sub UserForm_Terminate()
    oLo.Range.AutoFilter
End Sub
Click to expand...

Hi,
Need help, this code search by first letter only can you help to add option to search by any string (part of letter, number ect).
Thanks in advance.
 
Upvote 0
This line in Sub TextBox1_Change
Code: 
    oLo.Range.AutoFilter field:=3, Criteria1:=Me.TextBox1 & "*"
field 3 is the last name column, Criteria1 is what's typed in the textbox followed by anything
if you change it to "*" & Me.TextBox1 & "*" it will be any last name that contains what's in the textbox.

If you're wanting "*" & Me.TextBox1 & "*" to apply to the entire table at the same time, you should post that as a new question so the pros will see it and hopefully help out.

I'll be watching so we can both learn.
 
Upvote 0
NoSparks said:
This line in Sub TextBox1_Change
Code: 
    oLo.Range.AutoFilter field:=3, Criteria1:=Me.TextBox1 & "*"
field 3 is the last name column, Criteria1 is what's typed in the textbox followed by anything
if you change it to "*" & Me.TextBox1 & "*" it will be any last name that contains what's in the textbox.

If you're wanting "*" & Me.TextBox1 & "*" to apply to the entire table at the same time, you should post that as a new question so the pros will see it and hopefully help out.

I'll be watching so we can both learn.
Click to expand...
hi,
Thank you very much for your quick response, i don't know much about vba in fact don't know nothing, i just combine different code to get desire result according to my needs. what i am looking for is the same as code below, i want to get data from other sheet where this code is filtering data from same sheet please help.
Thanks.
Code: 
Private Sub cmdadd_Click()
Dim addme As Range
    Dim x As Integer
    Set addme = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
    For x = 0 To Me.lstselector.ListCount - 1
        If Me.lstselector.Selected(x) Then
            addme = Me.lstselector.List(x)
            addme.Offset(0, 1) = Me.lstselector.List(x, 1)
            addme.Offset(0, 2) = Me.lstselector.List(x, 2)
            addme.Offset(0, 3) = Me.lstselector.List(x, 3)
            
            Set addme = addme.Offset(1, 0)
        End If
    Next x
    For x = 0 To Me.lstselector.ListCount - 1
        If Me.lstselector.Selected(x) Then Me.lstselector.Selected(x) = False
    Next x
End Sub


Private Sub CommandButton1_Click()

    Unload Me
End Sub

Private Sub TextBox1_Change()
'ListBox content is updated whenever the (filter) textbox is modified
Dim SRan As Range, ohYes As Boolean, rCount As Long
'
Set SRan = Range(Range("A2"), Range("A2").End(xlDown).End(xlToRight))  'This is the Row Source
ReDim sArr(1 To SRan.Columns.Count, 1 To SRan.Rows.Count)
For i = 1 To SRan.Rows.Count
    ohYes = False
    For j = 1 To SRan.Columns.Count
        If InStr(1, SRan.Cells(i, j).Value, TextBox1.Value, vbTextCompare) > 0 Then
            ohYes = True
            Exit For
        End If
    Next j
    If ohYes Then
        rCount = rCount + 1
        For j = 1 To SRan.Columns.Count
            sArr(j, rCount) = SRan.Cells(i, j).Value
        Next j
    End If
Next i
'Resize sArr:
If rCount > 0 Then
    ReDim Preserve sArr(1 To j - 1, 1 To rCount)
Else
    ReDim Preserve sArr(1 To j - 1, 1 To 1)
End If
'Sort the array:
If UBound(sArr, 2) > 1 Then
'sArr is a true array:
    sArr = bbSort(Application.WorksheetFunction.Transpose(sArr))
    lstselector.List = sArr
Else
'If one line only it is a bit more complex:
    Me.lstselector.Clear
    Me.lstselector.AddItem
    For i = 1 To UBound(sArr)
        Me.lstselector.Column(i - 1, 0) = sArr(i, 1)
    Next i
End If
End Sub

Private Sub UserForm_Initialize()
Dim sArr(), SRan As Range
Me.OptionButton1 = True
Set SRan = Range(Range("A2"), Range("A2").End(xlDown).End(xlToRight))
ReDim sArr(1 To SRan.Rows.Count, 1 To SRan.Columns.Count)
sArr = SRan.Value
sArr = bbSort(sArr)

Me.lstselector.List = sArr

End Sub



Function bbSort(ByVal lArr) As Variant
Dim tTmp
On Error Resume Next
UB2 = UBound(lArr, 2)
On Error GoTo 0
If iSort < 50 And UB2 > 1 Then
    lb0 = LBound(lArr)
    For i = lb0 To UBound(lArr) - 1
        For j = i + 1 To UBound(lArr)
            If UCase(lArr(i, lb0 + iSort)) > UCase(lArr(j, lb0 + iSort)) Then
                For k = LBound(lArr, 2) To UBound(lArr, 2)
                    tTmp = lArr(j, k)
                    lArr(j, k) = lArr(i, k)
                    lArr(i, k) = tTmp
                Next k
            End If
        Next j
    Next i
End If
bbSort = lArr
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Run Time 13 Mismatch Error
Replies
8
Views
551
Alex Blakenburg
A
R
  • Question
Delete from 2 tables at same time
Replies
2
Views
281
Rfriend
R
R
  • Solved
Add from multiselect listbox items with multiple columns to another list box using cmd buttons
Replies
6
Views
3K
John_w
J
V
  • Solved
VBA search in listbox when used combobox and textbox-To be modified
2
Replies
13
Views
355
velu888
V
sparky2205
  • Question
ListBox not highlighting selection
Replies
0
Views
133
sparky2205
sparky2205

Forum statistics

Threads
1,216,474
Messages
6,130,841
Members
449,598
Latest member
sunny_ksy

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top