Problem with showing more than 10 columns on listbox

S

sofas

Well-known Member
Joined
Sep 11, 2022
Messages
559
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
Hello, I have this code to search in several specific Excel sheets and show the results to the listbox. But it does not work when the number of columns exceeds 10. Is there a way to show 12 or 13 columns on the listbox? Here's a look at what I'm trying to find in the following code

VBA Code: 
ivate Sub CommandButton1_Click()
     Dim Found As Range
    Dim Search As Variant
    Dim firstaddress As String, msg As String
    
  Me.ListBox1.Clear
    
    Search = Me.TextBox1.Value
      Do
    If Me.TextBox1 = "" Then Exit Sub
    Loop Until Search <> ""
  Dim sh As Worksheet
For Each sh In Sheets(Array("Sheet1", "Sheet2", "Sheet5", "Sheet8"))
        With sh.UsedRange
            Set Found = sh.Range("a2:j1000").Find(Search, LookIn:=xlValues, lookat:=xlWhole)
            If Not Found Is Nothing Then
                firstaddress = Found.Address
                Do
                 With ListBox1
                 .AddItem
                .List(.ListCount - 1, 0) = sh.Cells(Found.Row, 1).Value
                .List(.ListCount - 1, 1) = sh.Cells(Found.Row, 2).Value
                .List(.ListCount - 1, 2) = sh.Cells(Found.Row, 3).Value
                .List(.ListCount - 1, 3) = sh.Cells(Found.Row, 4).Value
                .List(.ListCount - 1, 4) = sh.Cells(Found.Row, 5).Value
                .List(.ListCount - 1, 5) = sh.Cells(Found.Row, 6).Value
                .List(.ListCount - 1, 6) = sh.Cells(Found.Row, 7).Value
                .List(.ListCount - 1, 7) = sh.Cells(Found.Row, 8).Value
                .List(.ListCount - 1, 8) = sh.Cells(Found.Row, 9).Value
                .List(.ListCount - 1, 9) = sh.Cells(Found.Row, 10).Value
               ' .List(.ListCount - 1, 10) = Found.Address
               '.List(.ListCount - 1, 11) = Sh.Name
            End With
                
                    Set Found = .FindNext(Found)
                Loop While Not Found Is Nothing And Found.Address <> firstaddress

            Else
          MsgBox "Nothing found."
            End If
        End With
        Set Found = Nothing
    Next
End Sub
 
Sort by date Sort by votes
dmt32 said:
Hi,
As already pointed out, to exceed the 10 column limit of AddItem property of the control you need to use either the List property added from contents of an array (can be Range.Value) or the Rowsource property connected to a Range (only option if you want to display column headers)

For your requirement, a 2D array should do what you want but as you are searching multiple sheets, will need to correctly size the array by counting the total number of matches across all sheets first before populating it.

Not had a lot of time to spend on this & only tested on your sample data – my vain attempts to update your code may therefore need some adjustment / re-thinking but see if this will do what you want

Code: 
Private Sub CommandButton1_Click()
    Dim sh                  As Worksheet
    Dim firstaddress        As String, SearchAddress    As String
    Dim Found               As Range, wsRangeArr()      As Range
    Dim CountAllMatches     As Long, CountMatch         As Long
    Dim i                   As Long, r                  As Long, c As Long
    Dim Search              As Variant, SearchRange     As Variant
    Dim SearchSheetsArr     As Variant, CopyArr()       As Variant
   
    '----------------------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------------------
    Const ColCount  As Long = 12
   
    SearchAddress = "A:J"
    SearchSheetsArr = Array("Sheet1", "Sheet2", "Sheet5", "Sheet8")
    '----------------------------------------------------------------------------------------------------------
   
    Search = Me.TextBox1.Value
    If Len(Search) = 0 Then Exit Sub
   
    'loop all sheets in array
    For Each sh In ThisWorkbook.Worksheets(SearchSheetsArr)
        CountMatch = Application.CountIf(sh.Range(SearchAddress), Search)
        If CountMatch > 0 Then
            i = i + 1: ReDim Preserve wsRangeArr(1 To i): Set wsRangeArr(i) = sh.Range(SearchAddress)
            'total count of all matches in ranges
            CountAllMatches = CountAllMatches + CountMatch
        End If
        CountMatch = 0
    Next sh
   
    If CountAllMatches > 0 Then
        'size copy array
        ReDim CopyArr(1 To CountAllMatches, 1 To ColCount)
       
        'search sheets / ranges with matches
        r = 0
        For Each SearchRange In wsRangeArr
            'search range
            Set Found = SearchRange.Find(Search, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
           
                firstaddress = Found.Address
               
                Do
                    'populate array elements
                    r = r + 1
                    For c = 1 To UBound(CopyArr, xlColumns) - 2
                        CopyArr(r, c) = SearchRange.Cells(Found.Row, c).Text
                    Next c
                   
                    CopyArr(r, c) = Found.Address
                    CopyArr(r, c + 1) = SearchRange.Parent.Name
                   
                    Set Found = SearchRange.FindNext(Found)
                   
                Loop While Found.Address <> firstaddress
               
            'clear object variable
            Set Found = Nothing
           
        Next SearchRange
       
    End If
   
    'populate listbox or report no matches
    With Me.ListBox1
        .ColumnCount = IIf(CountAllMatches > 0, ColCount, 1)
        .List = IIf(CountAllMatches > 0, CopyArr, Array("No Match Found"))
        .Font.Size = IIf(CountAllMatches > 0, 9, 24)
        .TextAlign = IIf(CountAllMatches > 0, fmTextAlignLeft, fmTextAlignCenter)
    End With
   
End Sub

Private Sub TextBox1_Change()
    If Len(Me.TextBox1) = 0 Then Me.ListBox1.Clear
End Sub

The updated code first scans all the worksheets in the SearchsheetsArr array & creates a total count of all matches which is used to size the CopyArr. In addition, a second array wsRangeArr stores the sheet(s) range(s) which is used to search only those ranges with matches in the For Next part of your original code.

You will note that I added the “No Match Found” to display in the Listbox but you can change this if you prefer to show a MsgBox.


if all goes well, you should get 12 columns of matching search data from each sheet

View attachment 111304

Hope Helpful

Dave
Click to expand...
Thank you. I think it works well, except for searching for a specific date, meaning it only brings values, but when searching, for example, on 05/13/2024, it does not respond.
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
sofas said:
Thank you. I think it works well, except for searching for a specific date, meaning it only brings values, but when searching, for example, on 05/13/2024, it does not respond.
Click to expand...
Hi,
must confess did not think about testing your date values

Dates when using Range.Find method can be a little tricky but assuming they are real dates in the range then try this update & see if resolves

VBA Code: 
Private Sub CommandButton1_Click()
    Dim sh                  As Worksheet
    Dim LookIn              As XlFindLookIn
    Dim firstaddress        As String, SearchAddress    As String
    Dim Found               As Range, wsRangeArr()      As Range
    Dim CountAllMatches     As Long, CountMatch         As Long
    Dim i                   As Long, r                  As Long, c As Long
    Dim Search              As Variant, SearchRange     As Variant
    Dim SearchSheetsArr     As Variant, CopyArr()       As Variant
   
    '----------------------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------------------
    Const ColCount  As Long = 12
   
    SearchAddress = "A:J"
    SearchSheetsArr = Array("Sheet1", "Sheet2", "Sheet5", "Sheet8")
    '----------------------------------------------------------------------------------------------------------
   
    Search = Me.TextBox1.Value
    If Len(Search) = 0 Then Exit Sub
    If IsDate(Search) Then Search = DateValue(Search): LookIn = xlFormulas Else LookIn = xlValues
   
    'loop all sheets in array
    For Each sh In ThisWorkbook.Worksheets(SearchSheetsArr)
        CountMatch = Application.CountIf(sh.Range(SearchAddress), Search)
        If CountMatch > 0 Then
            i = i + 1: ReDim Preserve wsRangeArr(1 To i): Set wsRangeArr(i) = sh.Range(SearchAddress)
            'total count of all matches in ranges
            CountAllMatches = CountAllMatches + CountMatch
        End If
        CountMatch = 0
    Next sh
   
    If CountAllMatches > 0 Then
        'size copy array
        ReDim CopyArr(1 To CountAllMatches, 1 To ColCount)
       
        'search sheets / ranges with matches
        r = 0
        For Each SearchRange In wsRangeArr
            'search range
            Set Found = SearchRange.Find(Search, LookIn:=LookIn, lookat:=xlWhole, MatchCase:=False)
           
                firstaddress = Found.Address
               
                Do
                    'populate array elements
                    r = r + 1
                    For c = 1 To UBound(CopyArr, xlColumns) - 2
                        CopyArr(r, c) = SearchRange.Cells(Found.Row, c).Text
                    Next c
                   
                    CopyArr(r, c) = Found.Address
                    CopyArr(r, c + 1) = SearchRange.Parent.Name
                   
                    Set Found = SearchRange.FindNext(Found)
                   
                Loop While Found.Address <> firstaddress
               
            'clear object variable
            Set Found = Nothing
           
        Next SearchRange
       
    End If
   
    'populate listbox or report no matches
    With Me.ListBox1
        .ColumnCount = IIf(CountAllMatches > 0, ColCount, 1)
        .List = IIf(CountAllMatches > 0, CopyArr, Array("No Match Found"))
        .Font.Size = IIf(CountAllMatches > 0, 9, 24)
        .TextAlign = IIf(CountAllMatches > 0, fmTextAlignLeft, fmTextAlignCenter)
    End With
   
End Sub

Dave
 
Upvote 0
Solution
dmt32 said:
Hi,
must confess did not think about testing your date values

Dates when using Range.Find method can be a little tricky but assuming they are real dates in the range then try this update & see if resolves

VBA Code: 
Private Sub CommandButton1_Click()
    Dim sh                  As Worksheet
    Dim LookIn              As XlFindLookIn
    Dim firstaddress        As String, SearchAddress    As String
    Dim Found               As Range, wsRangeArr()      As Range
    Dim CountAllMatches     As Long, CountMatch         As Long
    Dim i                   As Long, r                  As Long, c As Long
    Dim Search              As Variant, SearchRange     As Variant
    Dim SearchSheetsArr     As Variant, CopyArr()       As Variant
  
    '----------------------------------------------------------------------------------------------------------
    '                                           SETTINGS
    '----------------------------------------------------------------------------------------------------------
    Const ColCount  As Long = 12
  
    SearchAddress = "A:J"
    SearchSheetsArr = Array("Sheet1", "Sheet2", "Sheet5", "Sheet8")
    '----------------------------------------------------------------------------------------------------------
  
    Search = Me.TextBox1.Value
    If Len(Search) = 0 Then Exit Sub
    If IsDate(Search) Then Search = DateValue(Search): LookIn = xlFormulas Else LookIn = xlValues
  
    'loop all sheets in array
    For Each sh In ThisWorkbook.Worksheets(SearchSheetsArr)
        CountMatch = Application.CountIf(sh.Range(SearchAddress), Search)
        If CountMatch > 0 Then
            i = i + 1: ReDim Preserve wsRangeArr(1 To i): Set wsRangeArr(i) = sh.Range(SearchAddress)
            'total count of all matches in ranges
            CountAllMatches = CountAllMatches + CountMatch
        End If
        CountMatch = 0
    Next sh
  
    If CountAllMatches > 0 Then
        'size copy array
        ReDim CopyArr(1 To CountAllMatches, 1 To ColCount)
      
        'search sheets / ranges with matches
        r = 0
        For Each SearchRange In wsRangeArr
            'search range
            Set Found = SearchRange.Find(Search, LookIn:=LookIn, lookat:=xlWhole, MatchCase:=False)
          
                firstaddress = Found.Address
              
                Do
                    'populate array elements
                    r = r + 1
                    For c = 1 To UBound(CopyArr, xlColumns) - 2
                        CopyArr(r, c) = SearchRange.Cells(Found.Row, c).Text
                    Next c
                  
                    CopyArr(r, c) = Found.Address
                    CopyArr(r, c + 1) = SearchRange.Parent.Name
                  
                    Set Found = SearchRange.FindNext(Found)
                  
                Loop While Found.Address <> firstaddress
              
            'clear object variable
            Set Found = Nothing
          
        Next SearchRange
      
    End If
  
    'populate listbox or report no matches
    With Me.ListBox1
        .ColumnCount = IIf(CountAllMatches > 0, ColCount, 1)
        .List = IIf(CountAllMatches > 0, CopyArr, Array("No Match Found"))
        .Font.Size = IIf(CountAllMatches > 0, 9, 24)
        .TextAlign = IIf(CountAllMatches > 0, fmTextAlignLeft, fmTextAlignCenter)
    End With
  
End Sub

Dave
Click to expand...
Thank you, it was successful. I really appreciate your help.
 
Upvote 0
sofas said:
Thank you, it was successful. I really appreciate your help.
Click to expand...
Most welcome glad solution resolved your issue & Appreciate your feedback

Now the date part is working & just for info, you should be able to search for a date in most recognised formats e.g. entering Jan 16 2017 in your textbox should find matching dates

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Searching using TextBox and ListBox
Replies
1
Views
279
campbell1093
C
I
  • Solved
Listbox to show dd/mm/yyyy & not mm/dd/yyyy
2
Replies
13
Views
144
Alex Blakenburg
A
I
  • Solved
If no values are found then show Msgbox
Replies
6
Views
121
ipbr21054
I
I
  • Solved
Also have the row number shown in Listbox on userform advice
Replies
7
Views
145
NoSparks
N
I
  • Question Question
Select Listbox value to be then taken to customer on worksheet
Replies
1
Views
138
ipbr21054
I

Forum statistics

Threads
1,224,811
Messages
6,181,080
Members
453,021
Latest member
Justyna P

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