VBA listbox search

C

chunu

Board Regular
Joined
Jul 5, 2012
Messages
109
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

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
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
653
Alex Blakenburg
A
R
  • Question Question
Delete from 2 tables at same time
Replies
2
Views
388
Rfriend
R
R
  • Question Question
VBA Generate email with multiple data in body.
Replies
2
Views
135
Logit
Logit
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
267
RoryA
RoryA
C
  • Question Question
Searching using TextBox and ListBox
Replies
1
Views
279
campbell1093
C

Forum statistics

Threads
1,224,827
Messages
6,181,195
Members
453,021
Latest member
pingpong7117

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