Populate Listbox1 based on TextBox1 value

[jagrenet]

I have UserForm1 with ListBox1 and TextBox1. What I am trying to accomplish is to allow the User to search "Sheet2" to find all records that match their input and populate the ListBox1. I have seen various methods to do this and have applied a couple of these methods however, the process falls flat at the same exact point, each time the code is run. With the 2 examples I have below, everything seems to run just fine until I get to the point of typing in the Textbox. I am using the TextBox1_Change() method and am expecting the Listbox to begin showing records immediately, with even the first character being typed. Issue: When I type, the ListBox remains blank. I have implemented 2 different versions of code. Same results, at the same spot, each time. (please see code below)

VERSION 1 - Returns nothing to the ListBox.

Private Sub TextBox1_Change()

On Error Resume Next

Workbooks("SalesForce Cases_v1.4_C1_Logo_Import_Button.xlsm").Activate
Worksheets("Sheet2").Select

Dim c As Integer
Dim column_headers
column_headers = "E"
criterion = column_headers

Sheet2.Cells(2, 4) = criterion

ListBox1.RowSource = Sheet2.Cells(2, 4)



Dim r, last_row, x As Integer
Dim i As Long
last_row = Sheet2.Range("E10000" & Rows.Count).End(xlUp).Row
For r = 2 To last_row
For x = 1 To Len(Sheet2.Cells(i, 2))


a = Len(UserForm1.TextBox1.TextLength)
If UCase(Left(Sheet2.Cells(r, criterion).Value, a)) = UCase(UserForm1.TextBox1.Text) Then

With UserForm1.ListBox1

.AddItem Sheet2.Cells(r, "A").Value
.List(.ListCount - 1, 1) = Sheet2.Cells(r, "B").Value
.List(.ListCount - 1, 2) = Sheet2.Cells(r, "C").Value
.List(.ListCount - 1, 3) = Sheet2.Cells(r, "D").Value
.List(.ListCount - 1, 4) = Sheet2.Cells(r, "E").Value
.List(.ListCount - 1, 5) = Sheet2.Cells(r, "F").Value
.List(.ListCount - 1, 6) = Sheet2.Cells(r, "G").Value
.List(.ListCount - 1, 7) = Sheet2.Cells(r, "H").Value
.List(.ListCount - 1, 8) = Sheet2.Cells(r, "I").Value
.List(.ListCount - 1, 9) = Sheet2.Cells(r, "J").Value
.List(.ListCount - 1, 10) = Sheet2.Cells(r, "K").Value
.List(.ListCount - 1, 11) = Sheet2.Cells(r, "L").Value
.List(.ListCount - 1, 12) = Sheet2.Cells(r, "M").Value
.List(.ListCount - 1, 13) = Sheet2.Cells(r, "N").Value
.List(.ListCount - 1, 14) = Sheet2.Cells(r, "O").Value
.List(.ListCount - 1, 15) = Sheet2.Cells(r, "P").Value
.List(.ListCount - 1, 16) = Sheet2.Cells(r, "Q").Value
.List(.ListCount - 1, 17) = Sheet2.Cells(r, "R").Value
.List(.ListCount - 1, 18) = Sheet2.Cells(r, "S").Value
.List(.ListCount - 1, 19) = Sheet2.Cells(r, "T").Value
.List(.ListCount - 1, 20) = Sheet2.Cells(r, "U").Value
.List(.ListCount - 1, 21) = Sheet2.Cells(r, "V").Value
.List(.ListCount - 1, 22) = Sheet2.Cells(r, "W").Value
.List(.ListCount - 1, 23) = Sheet2.Cells(r, "X").Value
.List(.ListCount - 1, 24) = Sheet2.Cells(r, "Y").Value
.List(.ListCount - 1, 25) = Sheet2.Cells(r, "Z").Value
.List(.ListCount - 1, 26) = Sheet2.Cells(r, "AA").Value
.List(.ListCount - 1, 27) = Sheet2.Cells(r, "AB").Value
.List(.ListCount - 1, 28) = Sheet2.Cells(r, "AC").Value


End With
End If
Next x
Next r


End Sub

===================================================================================
VERSION 2 - Same results. Returns nothing to the ListBox.

Private Sub TextBox1_Change()

Dim i As Long
For i = 2 To Sheet2.Range("E10000").End(xlUp).Row
For x = 1 To Len(Sheet2.Cells(i, 1))


a = Me.TextBox1.TextLength
If UCase(Mid(Sheet2.Cells(i, 1), x, a)) = Me.TextBox1 And Me.TextBox1 <> "" Then

Me.ListBox1.AddItem Sheet2.Cells(i, 1)
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = "0" & Sheet2.Cells(i, 2)

End If
Next x
Next i

End Sub
===================================================================================

There could potentially be some leftover code from previous attempts that simply did not get cleaned up. Please ignore.

 

[dmt32]

I have run through the Procedures in order to test and I am noticing, .... when I intentionally misspell a name, multiple times (some people do that) .... the ReSize feature eventually shrinks the ListBox down so far that it is unreadable. Is there any way to diminish or correct that effect ??
Other than that, everything else works flawlessly.

Oh the annoyances of vba – not an issue I have noticed before will have to find time to look in to it.
For now, you should be able to fix the width of your listbox using the Width property of the control

just insert where shown

If Len(Search) > 0 Then
            
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, 5)) Like UCase(Search) & "*" Then
                    r1 = r1 + 1
                    For c = 1 To UBound(arr, 2)
                        FilterArr(r1, c) = arr(r, c)
                    Next c
                End If
            Next r
            
            .List = ResizeArray(FilterArr, r1)
            
        Else
            
            'display full list
            .List = arr
            
        End If
        
        .Width = 670
        
    End With

Adjust size as required.

 

[jagrenet]

Oh the annoyances of vba – not an issue I have noticed before will have to find time to look in to it.
For now, you should be able to fix the width of your listbox using the Width property of the control

just insert where shown

If Len(Search) > 0 Then
            
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, 5)) Like UCase(Search) & "*" Then
                    r1 = r1 + 1
                    For c = 1 To UBound(arr, 2)
                        FilterArr(r1, c) = arr(r, c)
                    Next c
                End If
            Next r
            
            .List = ResizeArray(FilterArr, r1)
            
        Else
            
            'display full list
            .List = arr
            
        End If
       
        .Width = 670
       
    End With

Adjust size as required.

Yes. I have a couple more minor bugs to iron out so, this particular piece has not been "released" into the production environment yet. Point being, there's no rush. I'm just trying to cover all bases so there are minimal problems when I do release it. Whenever you have the opportunity is absolutely fine.
Thanks Dave !!!

 

[jagrenet]

Yes. I have a couple more minor bugs to iron out so, this particular piece has not been "released" into the production environment yet. Point being, there's no rush. I'm just trying to cover all bases so there are minimal problems when I do release it. Whenever you have the opportunity is absolutely fine.
Thanks Dave !!!

Hi Dave,

Based on the code which, is working very well, ........ how would I go about changing the column that the user's text is compared to. The TextBox input is currently finding the typed characters inside of Column 5 - ("E"). I want to provide an option to the user that would need to compare the text from column 13 - ("M") ?? - I have scoured the code over and over however, I cannot find where Column "E" is specified as the target. Can you help with that ??

Thanks,
Jeff

 

[dmt32]

Hi,
try changing the Column number in the array to required search column

 If UCase(arr(r, 13)) Like UCase(Search) & "*" Then

or you could include both if required,

If Len(Search) > 0 Then
            
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, 5)) Like UCase(Search) & "*" Or _
                    UCase(arr(r, 13)) Like UCase(Search) & "*" Then
                    
                    r1 = r1 + 1
                    For c = 1 To UBound(arr, 2)
                        FilterArr(r1, c) = arr(r, c)
                    Next c
                End If
                
            Next r
            
            .List = ResizeArray(FilterArr, r1)
            
        Else
            
            'display full list
            .List = arr
            
        End If
        
        .Width = 670
        
    End With

Dave

 

[jagrenet]

Hi,
try changing the Column number in the array to required search column

 If UCase(arr(r, 13)) Like UCase(Search) & "*" Then

or you could include both if required,

If Len(Search) > 0 Then
            
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, 5)) Like UCase(Search) & "*" Or _
                    UCase(arr(r, 13)) Like UCase(Search) & "*" Then
                   
                    r1 = r1 + 1
                    For c = 1 To UBound(arr, 2)
                        FilterArr(r1, c) = arr(r, c)
                    Next c
                End If
                
            Next r
            
            .List = ResizeArray(FilterArr, r1)
            
        Else
            
            'display full list
            .List = arr
            
        End If
        
        .Width = 670
        
    End With

Dave

Thanks Dave!!

I did try that actually.
Being the only "5" in the entire piece, I assumed that was the reference to the Column. I did change it to "13" and stepped through the code (F8), but it did not "hit" on any of the characters in that column ("M") and remained blank. Not sure what I am missing but, I did try. Initially, I was going to offer the user the option to "drill down" in their search by "checking" a checkbox ..... such as, .... "If CheckBox1.Checked = True Then" search Column "13" ........ Else, "If CheckBox1.Checked = False Then" search Column "5". Something to that effect. I figured I was on the right path when I saw "5" as the Column reference. But, when it didn't work by changing it to "13", I wanted to get your opinion.

Jeff

 

[dmt32]

Hi,
if you want to make Search Column a choice then you can try something like this

Dim SearchColumn As Long
    
    SearchColumn = IIf(Me.CheckBox1, 13, 5)

    If Len(Search) > 0 Then
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, SearchColumn)) Like UCase(Search) & "*" Then

'rest of code

Add the lines of code shown in BOLD

Difficult to determine why change of search column yields no results without seeing data

Dave

 

[jagrenet]

Hi,
if you want to make Search Column a choice then you can try something like this

Dim SearchColumn As Long
   
    SearchColumn = IIf(Me.CheckBox1, 13, 5)

    If Len(Search) > 0 Then
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, SearchColumn)) Like UCase(Search) & "*" Then

'rest of code

Add the lines of code shown in BOLD

Difficult to determine why change of search column yields no results without seeing data

Dave

Hello,

I have added the updated .xlsm file to the DropBox folder for your reference. If and when you can get a chance to run it, it may point out something to you that I am missing or overlooking. I appreciate your help. I will apply the most recent code you provided and test as soon as I can.

Jeff

 

[jagrenet]

Hello,

I have added the updated .xlsm file to the DropBox folder for your reference. If and when you can get a chance to run it, it may point out something to you that I am missing or overlooking. I appreciate your help. I will apply the most recent code you provided and test as soon as I can.

Jeff

Quick update Dave.
As a test, I just changed "5" to "13" in the original code ..... and it worked - this time. Last night it was not working at all. Strange behavior and not sure why it is intermittent as such. Any ideas ??

Jeff

 

[dmt32]

At this stage none - if I get a quiet moment will go back & download your updated file.

Dave

 

[sofas]

sorry, oversight on my part, try this update to codes

Private Sub TextBox1_Change()
   
    Dim ws          As Worksheet
    Dim rng         As Range
    Dim r           As Long, c As Long, Lastrow As Long, r1 As Long
    Dim Search      As String
    Dim FilterArr()   As Variant
   
    Search = Me.TextBox1.Value
   
    Set ws = ThisWorkbook.Worksheets("Sheet2")
   
    Lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    'size worksheet data range
    Set rng = ws.Cells(2, 1).Resize(Lastrow, 28)
   
    arr = rng.Value2
   
    ReDim FilterArr(1 To rng.Rows.Count, 1 To rng.Columns.Count)
   
    With Me.ListBox1
        'disconnect rowsource
        .RowSource = ""
        .ColumnHeads = False
       
        'size listbox
        .ColumnCount = rng.Columns.Count
       
        .Clear
       
        If Len(Search) > 0 Then
           
            For r = 1 To UBound(arr, 1)
                If UCase(arr(r, 5)) Like UCase(Search) & "*" Then
                    r1 = r1 + 1
                    For c = 1 To UBound(arr, 2)
                        FilterArr(r1, c) = arr(r, c)
                    Next c
                End If
            Next r
           
            .List = ResizeArray(FilterArr, r1)
           
        Else
           
            'display full list
            .List = arr
           
            'or use rowsource
            're-connect rowsource to display all data with column heads
            '.RowSource = ws.Name & "!" & rng.Address
            '.ColumnHeads = True
           
        End If
       
    End With
   
End Sub
Function ResizeArray(ByVal arr As Variant, ByVal RowsCount As Long) As Variant
    Dim r       As Long, c As Long
    Dim Arr2()  As Variant
    
     If RowsCount > 0 Then
     'size array to match filtered data
        ReDim Arr2(1 To RowsCount, 1 To UBound(arr, 2))
        For r = 1 To RowsCount
            For c = 1 To UBound(arr, 2)
        'pass matching elements of arr to arr2
            Arr2(r, c) = arr(r, c)
            Next c
        Next
     End If
    ResizeArray = IIf(RowsCount > 0, Arr2, Array("No Match Found"))
End Function

You see a message display in Listbox if no matches are found



whilst could include this feature when building the array suggest that you just include the code at start of your transfer button

Private Sub TransferButton_Click()
    Dim i As Long
    For i = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.Selected(i) = True
    Next i
   
    'rest of code
End Sub

Dave

Hello, is it possible to execute the same hope and display the data of several specific sheets on the listbox