Fill listbox for 1 million rows

[YasserKhalil]

Hello everyone

I have the following code

Code: Select all

Private Sub ComboBox1_Change()
    Dim ws          As Worksheet
    Dim a           As Variant
    Dim b()         As Variant
    Dim temp        As Variant
    Dim i           As Long
    Dim x           As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    x = Me.ComboBox1.ListIndex
    temp = Me.ComboBox1.Value
    If (x = -1) + (temp = "") Then Exit Sub
    If IsNumeric(temp) Then temp = Val(temp)
    a = ws.Range("A1:L" & ws.Cells(Rows.Count, 12).End(xlUp).Row).Value
    ReDim b(1 To 1): b(1) = Application.Index(a, 1, 0)

    For i = 2 To UBound(a, 1)
        If temp Like "*" & a(i, 12) & "*" Then
            ReDim Preserve b(1 To UBound(b) + 1)
            b(UBound(b)) = Application.Index(a, i, 0)
        End If
    Next i

    If UBound(b) > 0 Then
        If UBound(b) = 1 Then
            Me.ListBox1.Column = Application.Index(b, 0, 0)
        Else
            Me.ListBox1.List = Application.Index(b, 0, 0)
        End If
    End If
End Sub

This is just example of how to fill the listbox after search process.
What I am searching for and know about ....
First Is using ReDim Preserve will be slow when dealing with large data of 1 million rows and 25 columns?
The same question for using Application.Index ..??

How can I fill the listbox using arrays without using Application.Index or ReDim Preserve which I think is the cause of slow process..?

I don't need the above code but need a sample or example code that only uses arrays with the fastest in performance and speed
Thanks advanced for help

[HansV]

How many rows do you expect to meet the criteria (in other words, how many rows will the list box have)?

[YasserKhalil]

In the listbox there will be about 5000 rows or a bit more. Is there a limitation in the listbox for the number of results?

[HansV]

ReDim 5000 times shouldn't be too bad. An alternative would be to start with ReDim b(1 To 10000) and then use ReDim Preserve once at the end of the code to remove the unused rows.

But in my opinion, you should rethink the problem. A list box with 5000 rows is possible (the limit is 65535), but very user-unfriendly.

[YasserKhalil]

Thanks a lot. Can you give me a sample code to test on the file?

[HansV]

Here is a version that uses ReDim Preserve only once.

Code: Select all

Private Sub ComboBox1_Change()
    Dim ws          As Worksheet
    Dim a           As Variant
    Dim b()         As Variant
    Dim temp        As Variant
    Dim i           As Long
    Dim x           As Long
    Dim n           As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    x = Me.ComboBox1.ListIndex
    temp = Me.ComboBox1.Value
    If (x = -1) + (temp = "") Then Exit Sub
    If IsNumeric(temp) Then temp = Val(temp)
    a = ws.Range("A1:L" & ws.Cells(Rows.Count, 12).End(xlUp).Row).Value
    ReDim b(1 To 10000)
    b(1) = Application.Index(a, 1, 0)

    For i = 2 To UBound(a, 1)
        If temp Like "*" & a(i, 12) & "*" Then
            n = n + 1
            b(n) = Application.Index(a, i, 0)
        End If
    Next i

    If n > 0 Then
        ReDim Preserve b(1 To n)
        If n = 1 Then
            Me.ListBox1.Column = Application.Index(b, 0, 0)
        Else
            Me.ListBox1.List = Application.Index(b, 0, 0)
        End If
    End If
End Sub

[YasserKhalil]

Thanks a lot. I have adopted the code to textbox like that

Code: Select all

Private Sub TextBox14_AfterUpdate()
    Dim ws          As Worksheet
    Dim a           As Variant
    Dim b()         As Variant
    Dim temp        As Variant
    Dim i           As Long
    Dim n           As Long

    Set ws = ThisWorkbook.Worksheets("Data")
    temp = Me.TextBox14.Value
    If temp = "" Then Me.ListBox1.Clear: Exit Sub
    a = ws.Range("A1:S" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To 10000)
    b(1) = Application.Index(a, 1, 0)

    For i = 2 To UBound(a, 1)
        If temp Like "*" & CStr(a(i, 1)) & "*" Then
            n = n + 1
            b(n) = Application.Index(a, i, 0)
        End If
    Next i

    If n > 0 Then
        Me.ListBox1.Clear
        ReDim Preserve b(1 To n)
        If n = 1 Then
            Me.ListBox1.Column = Application.Index(b, 0, 0)
        Else
            Me.ListBox1.List = Application.Index(b, 0, 0)
        End If
    End If
End Sub

When I typed 1 in the textbox, I got only one result and I expect hundreds of rows as the number 1 is partially exists in other items ...

[YasserKhalil]

I could find out the reason as this line should be for me like that

Code: Select all

If CStr(a(i, 1)) Like "*" & temp & "*" Then

Now I will try the code on the original file for more tests
Thank you very much for the great help

[YasserKhalil]

On the real file, it took about 25 seconds to search for one item. When I followed the code, I found the code takes too much time at this line

Code: Select all

b(n) = Application.Index(a, i, 0)

The last row of data is A1048574 and the number of columns is 25 .. I think using Index or worksheetfunctions in general would be taking too much time. I am not sure.