Search via textbox to auto-update listbox entries

问题

I would like to implement a search function in a listbox in a userform getting a better view of the many columns and unfortunately I can't find a solution.

The optimal solution would be, if I could search in a textbox for any row content (up to 12 columns containing data like e.g. name, ID, position, organization, ...) and the listbox would automatically update itself showing all matching entries.

In UserForm_Initialize I filled the listbox as follows:

Private Sub UserForm_Initialize()
 
With UserForm1
  .StartUpPosition = 1
  .Top = 1
  .Left = 1
End With
 
Dim last As Integer
         last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row + 1
 
ListBox1.ColumnCount = 12
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "30;50;200;60;30;110;110;90;50;40;50;80;60"
ListBox1.RowSource = "A2:M" & last
 
End Sub

I imagined the search function to filter the listbox depending on the input in Textbox1.

After long research and consideration (unfortunately I am an absolute vba amateur) the following code was created:

Private Sub TextBox1_Change()
    Dim i As Long
    On Error Resume Next
    Me.TextBox1.Text = StrConv(Me.TextBox1.Text, vbProperCase)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
        For x = 1 To 12
            a = Len(Me.TextBox1.Text)
            If Left(ActiveSheet.Cells(i, x).Value, a) = Me.TextBox1.Text And Me.TextBox1.Text <> "" Then
                Me.ListBox1.AddItem ActiveSheet.Cells(i, x).Value
                For c = 1 To 12
                    Me.ListBox1.List(ListBox1.ListCount - 1, c) = ActiveSheet.Cells(i, c + 1).Value
                Next c
            End If
        Next x
    Next i
End Sub

My question: Does anyone have a smarter / leaner solution or could maybe help to get my code working as currently I get the runtime error '9' on execution.

回答1:

ListBox display via filtering by search item

In the original post occurs a set of issues, so you have to consider several points.

As some of them get asked frequently as pure methodical questions, this compilation might help to gain a more overall view besides.

An important issue is that using the .AddItem method for each single element to be displayed, the listbox'es column count defaults to 10 columns only whereas you try to display more columns
thus raising an indexing error.
If you stick to the repetitive .AddItem method, you may use a workaround to overcome the 10 columns limitation: a temporary array assignment to the list box is sufficient to increase the number of columns to the corresponding number of array columns.
Furthermore and afaik it's not possible to clear or filter listbox data themselves, if they are bound by the .RowSource property. Therefore it would be necessary to do without .RowSource and to add data programmatically.
- Alternatively you might base .RowSource on a pre-filtered range (e.g. in a hidden sheet).
This means a further drawback: there's no way to display captions simply by setting the .ColumnHeads property to True without a set .RowSource. - That's why I chose sort of compromise by including heads as first data row in the answer below .
Note that the TextBox1_Change event will/would be called a second time if you change the textbox string content to proper Case within the same procedure. Therefore you need to prevent redoubled data entries by some escape code lines.
Furthermore it suffices to find the first occurrence of the given search item and to prevent unnecessary loops (e.g. by setting a boolean variable found).

The following example code demonstrates how to handle the shown issues trying to follow the original approach as close as possible (even if looping through a range instead of an array by means of VBA can be time consuming for greater data sets and your naming convention could prefer more meaningful variable names than x or c):

Option Explicit                 ' declaration head of Userform code module

Private Sub TextBox1_Change()
    Dim ws as WorkSheet             ' declare data sheet as WorkSheet
    set ws = Sheet1             ' << define data sheet's Code(Name)
    With Me.ListBox1
        .Clear                                  ' remove any prior items from listbox
        .List = ws.Range("A1:M1").Value2        ' display head & provide for sufficient columns
    End With
    If Me.TextBox1.Text = "" Then Exit Sub      ' no further display, so escape
    Dim SearchText As String
    SearchText = StrConv(Me.TextBox1.Text, vbProperCase)
    If Me.TextBox1.Text <> SearchText Then      ' avoid double call of Change event
        Me.TextBox1.Text = SearchText           ' display ProperCase
        Exit Sub                                ' force 2nd call after text change
    End If
    With ws
        Dim i As Long
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Dim lngth As Long: lngth = Len(SearchText)
            Dim x As Long
            For x = 1 To 12                         ' range columns
                Dim found As Boolean
                If Left(.Cells(i, x).Value, lngth) = SearchText Then
                    Me.ListBox1.AddItem .Cells(i, x).Value
                    Dim c As Long
                    For c = 1 To 12
                        Me.ListBox1.List(ListBox1.ListCount - 1, c) = .Cells(i, c + 1).Value
                    Next c
                    found = True                    ' check for 1st occurrence avoiding redundant loops
                End If
                If found Then
                    found = False
                    Exit For                        ' 1st finding suffices
                End If
            Next x
        Next i
    End With
End Sub

Private Sub UserForm_Initialize()

With Me
  .StartUpPosition = 1
  .Top = 1
  .Left = 1
End With

With Me.ListBox1
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'assign 2-dim array to .List property
    'to overcome default column count of 10 only!!
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    .Clear
    'needed to overcome default limit of 10 columns only!
    .List = Sheet1.[A1:M1].Value2          ' only column heads (i.e. 1 row) to start with
   '.RemoveItem 1                          ' (delete eventually if no head needed at all)
    .ColumnCount = 13
    .ColumnWidths = "30;50;100;60;30;110;110;90;50;40;50;80;60"
End With
  
End Sub

来源：https://stackoverflow.com/questions/64818906/search-via-textbox-to-auto-update-listbox-entries

标签

excel

vba

listbox

userform