Userform Listbox Not Displaying Correctly

zamber8

New Member
Joined
Oct 27, 2014
Messages
24
I have a Userform with 3 textboxes ("Textbox1-3") that search all active cells on sheet ("Locations") and list the found rows in the listbox ("Listbox1"). The Listbox should display 13 columns and is only used for viewing. I'm having trouble with 3 things:


  • When the results are displayed it is displaying column A from the sheet in column B on the listbox and so on leaving the first column in the listbox blank. I want the results to transfer over on the listbox the same way as the sheet displays.

  • In addition, it is searching/displaying the first row (which are the titles so shouldn't be searched)

  • Also, when I put in the count on the code below as anything over 9 I get a "Run-time error '380': Could not set the list property . Invalid property value." therefore only displaying 10 columns (first one blank and other 9 with data).

Code:
For Count = 1 To 9
ListBox1.List(ListBox1.ListCount - 1, Count) = Cells(UniqueItem(n), Count)

I've spent days looking at the code and searching the internet with no luck. I'm sure it is something very simple however I'm new at this and unable to figure it out! Thanks so much
-Amber

using Excel 2013


Code:
Public records As Variant
Option Base 1

Private Sub TextBox1_Change()
SearchText
End Sub
Private Sub TextBox2_Change()
SearchText
End Sub
Private Sub TextBox3_Change()
SearchText
End Sub


Private Sub SearchText()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("locations")
ws.Activate
Dim temp As Variant
Dim UniqueItem As Collection

Sheets(Label14.Caption).Select

temp = ThisWorkbook.ActiveSheet.UsedRange.Address
TextLen = 0
Searchbox = 1

For Count = 1 To 3
If Len(Me.Controls("Textbox" & Count).Value) > TextLen Then
TextLen = Len(Me.Controls("Textbox" & Count).Value)
strValueToPick = Me.Controls("Textbox" & Count).Value
End If
Next

If TextLen < 1 Then Exit Sub

On Error Resume Next

    With Range(ThisWorkbook.ActiveSheet.UsedRange.Address)
        Set rngfind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlFormulas, Lookat:=xlPart)
        If Not rngfind Is Nothing Then
            strFirstAddress = rngfind.Address
            Set rngPicked = rngfind
            Do
                Set rngPicked = Union(rngPicked, rngfind)
                Set rngfind = .FindNext(rngfind)
            Loop While Not rngfind Is Nothing And rngfind.Address <> strFirstAddress
        End If
    End With
    
    If strFirstAddress = "" Then Exit Sub
    If Not rngPicked Is Nothing Then
        rngPicked.Select
    End If

ListBox1.Clear

Set UniqueItem = New Collection
    
For Each c In Selection

RowText = Join(Application.Transpose(Application.Transpose(Range(Cells(c.Row, 1), Cells(c.Row, 13)).Value)), " ")
If Len(TextBox1.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox1.Text))) = 0 Then GoTo 20
If Len(TextBox2.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox2.Text))) = 0 Then GoTo 20
If Len(TextBox3.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox3.Text))) = 0 Then GoTo 20

On Error Resume Next

UniqueItem.Add CStr(c.Row), CStr(c.Row)

On Error GoTo 0

20 Next c

For n = 1 To UniqueItem.Count
    ListBox1.AddItem
UniqueItem (n)


For Count = 1 To 9
   ListBox1.List(ListBox1.ListCount - 1, Count) = Cells(UniqueItem(n), Count)
Next
Next

End Sub
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Hello zamber8,

You're welcome. Excellent, I am glad to hear that.

For those of you who are interested but don't want to download the workbook, here is the UserForm for the workbook in my last post.

Code:
Private Sub TextBox1_Change()
        Call SearchText(Me.ActiveControl)
End Sub
Private Sub TextBox2_Change()
        Call SearchText(Me.ActiveControl)
End Sub
Private Sub TextBox3_Change()
        Call SearchText(Me.ActiveControl)
End Sub


Private Sub SearchText(ByRef TB As MSForms.TextBox)

    Dim Data        As Variant
    Dim DataRng     As Range
    Dim Match       As Boolean
    Dim n           As Long
    Dim r           As Long
    Dim Row         As Range
    Dim RowData     As Variant
    Dim rngPicked   As Range
    Dim temp        As Variant
    Dim ws          As Worksheet
    
        Set ws = ThisWorkbook.Worksheets(Label14.Caption)
        Set DataRng = Intersect(ws.UsedRange, ws.UsedRange.Offset(1, 0))
        
        temp = ws.UsedRange.Address
        
        TextLen = 0
        Searchbox = 1
        
      ' Set the inital size of the Data array to the number of columns in row 1.
        ReDim Data(ws.Cells(1, Columns.Count).End(xlToLeft).Column, 0)
        
        For Count = 1 To 3
            If Len(TB.Value) > TextLen Then
                TextLen = Len(TB.Value)
                strValueToPick = TB.Value
            End If
        Next Count

        If TextLen < 1 Then Exit Sub

      ' Search for the TextBox entry and create a range of matching rows.
        For Each Row In ws.UsedRange.Rows.Offset(1, 0)
            Set rngFind = Row.Cells.Find(strValueToPick, Row.Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlNext, False, False, False)
            
            If Not rngFind Is Nothing Then
                strFirstAddress = rngFind.Address
                If rngPicked Is Nothing Then Set rngPicked = rngFind
                Set rngPicked = Union(rngPicked, rngFind)
            End If
        Next Row
        
        ListBox1.Clear
        
        If strFirstAddress = "" Then Exit Sub

        For Each c In rngPicked
            RowData = DataRng.Rows(c.Row - 1).Value
            
          ' Convert the 2-D RowData into a 1-D array
            RowData = Application.Transpose(RowData)
            RowData = Application.Transpose(RowData)
            
          ' Make a string called RowText from the RowData array.
            RowText = Join(RowData, " ")
            
          ' Search for text from the TextBox in the RowText.
            Match = InStr(1, RowText, Trim(TB.Text), vbTextCompare)
            
          ' Save matched RowText in the Data array.
            If TB.Text <> "" And Match = True Then
            
              ' Load the Data array with the RowData elements.
                For r = 0 To UBound(Data, 1) - 1
                    Data(r, n) = RowData(r + 1)
                Next r
                
              ' Increase the array size by 1. Only the last index of an array can be changed.
                n = n + 1
                
              ' Save the Data.
                ReDim Preserve Data(UBound(Data), n)
            End If

        Next c

      ' Transpose the Data into rows and columns.
        ListBox1.List = Application.Transpose(Data)
        
End Sub

Private Sub UserForm_Initialize()
        
    Dim n       As Long
    Dim Widths  As String
    
        ListBox1.ColumnCount = 15
        
          ' Set the widths of each ListBox column to the cell's width or hide the column.
            For n = 0 To ListBox1.ColumnCount - 1
                Widths = Widths & Cells(1, n + 1).Width & ";"
            Next n
        
            ListBox1.ColumnWidths = Left(Widths, Len(Widths) - 1)
        
End Sub
 
Upvote 0
Hi Leith,

Sorry to bother you again! I've been applying the code to other userforms that function the same way just search other sheets. Some of the sheets have columns that have unique identifiers or the date and time the user created/modified the record.

When the user is searching the sheet in the textboxes I don't want it to search these columns for the text entered. Is there a way on the search coding that you provided for it to search all used rows and columns with the exception of G-I?

Thanks

https://www.mediafire.com/?jkn03xc97bk9scq

Code:
Private Sub SearchText(ByRef TB As MSForms.TextBox)

    Dim Data        As Variant
    Dim DataRng     As range
    Dim Match       As Boolean
    Dim n           As Long
    Dim r           As Long
    Dim Row         As range
    Dim RowData     As Variant
    Dim rngPicked   As range
    Dim temp        As Variant
    Dim ws          As Worksheet
    
        Set ws = ThisWorkbook.Worksheets(Label14.Caption)
        Set DataRng = Intersect(ws.UsedRange, ws.UsedRange.Offset(1, 0))
        
        temp = ws.UsedRange.Address
        
        TextLen = 0
        Searchbox = 1
        
      ' Set the inital size of the Data array to the number of columns in row 1.
        ReDim Data(ws.Cells(1, Columns.Count).End(xlToLeft).Column, 0)
        
        For Count = 1 To 3
            If Len(TB.Value) > TextLen Then
                TextLen = Len(TB.Value)
                strValueToPick = TB.Value
            End If
        Next Count

        If TextLen < 1 Then Exit Sub

      ' Search for the TextBox entry and create a range of matching rows.
        For Each Row In ws.UsedRange.Rows.Offset(1, 0)
            Set rngFind = Row.Cells.Find(strValueToPick, Row.Cells(1,  1), xlFormulas, xlPart, xlByColumns, xlNext, False, False, False)
            
            If Not rngFind Is Nothing Then
                strFirstAddress = rngFind.Address
                If rngPicked Is Nothing Then Set rngPicked = rngFind
                Set rngPicked = Union(rngPicked, rngFind)
            End If
        Next Row
        
        ListBox1.Clear
        
        If strFirstAddress = "" Then Exit Sub

        For Each c In rngPicked
            RowData = DataRng.Rows(c.Row - 1).Value
            
          ' Convert the 2-D RowData into a 1-D array
            RowData = Application.Transpose(RowData)
            RowData = Application.Transpose(RowData)
            
          ' Make a string called RowText from the RowData array.
            RowText = Join(RowData, " ")
            
          ' Search for text from the TextBox in the RowText.
            Match = InStr(1, RowText, Trim(TB.Text), vbTextCompare)
            
          ' Save matched RowText in the Data array.
            If TB.Text <> "" And Match = True Then
            
              ' Load the Data array with the RowData elements.
                For r = 0 To UBound(Data, 1) - 1
                    Data(r, n) = RowData(r + 1)
                Next r
                
              ' Increase the array size by 1. Only the last index of an array can be changed.
                n = n + 1
                
              ' Save the Data.
                ReDim Preserve Data(UBound(Data), n)
            End If

        Next c

      ' Transpose the Data into rows and columns.
        ListBox1.List = Application.Transpose(Data)
        
End Sub
 
Upvote 0
Hello zamber8,

Its no bother. I do have a question about the search. Do you want the data from columns G through I to still appear in the ListBox?
 
Upvote 0
Hello,

A-G should show on the Listbox however the search function should exclude searching data in G-I.

Thanks

Amber
 
Upvote 0
Hello Amber,

Thanks for clearing that up. I will make those changes to the macro for you.
 
Upvote 0
Hello Amber,

Here is the update search macro code. the changes are marked in blue.

Rich (BB code):
Private Sub SearchText(ByRef TB As MSForms.TextBox)

    Dim Data        As Variant
    Dim DataRng     As Range
    Dim Match       As Boolean
    Dim n           As Long
    Dim r           As Long
    Dim Row         As Range
    Dim RowData     As Variant
    Dim rngPicked   As Range
    Dim temp        As Variant
    Dim ws          As Worksheet
    
        Set ws = ThisWorkbook.Worksheets(Label14.Caption)
        Set DataRng = Intersect(ws.UsedRange, ws.UsedRange.Offset(1, 0))
        
        temp = ws.UsedRange.Address
        
        TextLen = 0
        Searchbox = 1
        
      ' Set the inital size of the Data array to the number of columns in row 1.
        ReDim Data(ws.Cells(1, Columns.Count).End(xlToLeft).Column, 0)
        
        For Count = 1 To 3
            If Len(TB.Value) > TextLen Then
                TextLen = Len(TB.Value)
                strValueToPick = TB.Value
            End If
        Next Count

        If TextLen < 1 Then Exit Sub

      ' Search for the TextBox entry and create a range of matching rows.
        For Each Row In ws.UsedRange.Rows.Offset(1, 0)
            Set RngFind = Row.Cells.Find(strValueToPick, Row.Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlNext, False, False, False)
            
            If Not RngFind Is Nothing Then
              ' Exclude columns "G:I" from the search
                Select Case RngFind.Column
                    Case 7, 8, 9 ' Do nothing - Skip these columns.
                    Case Else:
                        strFirstAddress = RngFind.Address
                        If rngPicked Is Nothing Then Set rngPicked = RngFind
                        Set rngPicked = Union(rngPicked, RngFind)
                End Select
            End If
        Next Row
        
        ListBox1.Clear
        
        If strFirstAddress = "" Then Exit Sub

        For Each c In rngPicked
            RowData = DataRng.Rows(c.Row - 1).Value
            
          ' Convert the 2-D RowData into a 1-D array
            RowData = Application.Transpose(RowData)
            RowData = Application.Transpose(RowData)
            
          ' Make a string called RowText from the RowData array.
            RowText = Join(RowData, " ")
            
          ' Search for text from the TextBox in the RowText.
            Match = InStr(1, RowText, Trim(TB.Text), vbTextCompare)
            
          ' Save matched RowText in the Data array.
            If TB.Text <> "" And Match = True Then
            
              ' Load the Data array with the RowData elements.
                For r = 0 To UBound(Data, 1) - 1
                    Data(r, n) = RowData(r + 1)
                Next r
                
              ' Increase the array size by 1. Only the last index of an array can be changed.
                n = n + 1
                
              ' Save the Data.
                ReDim Preserve Data(UBound(Data), n)
            End If

        Next c

      ' Transpose the Data into rows and columns.
        ListBox1.List = Application.Transpose(Data)
        
End Sub
 
Upvote 0
Hi Leith,
For some reason column 1 is not being searched for when text box 1-3 are typed in. What in the code should I alter?

Thanks
 
Upvote 0

Forum statistics

Threads
1,214,918
Messages
6,122,249
Members
449,075
Latest member
staticfluids

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