How to optimize this piece of code to improve calculation speed?

[dourpil]

Hi everyone!

I have a "source database" of about 1500 rows and 7 columns.

In my userform, I fill 3 listboxes with unique values from 3 of my source database columns. These listboxes will act as dynamic filters:
The user can select items in the listboxes, which will 'filter' my table and display, in a fourth listbox (called Preview), only the table rows which correspond to the selected items.

I don't think my code is very good at the moment. It works, but when the selected items are such that about 500 items have to be displayed in my Preview listbox, the program takes a few seconds to respond.


First listbox allows for multiple selections. Here is how I get its data:

For x = 0 To Me.LbCat.ListCount - 1
    If Me.LbCat.Selected(x) = True Then
        narray = narray + 1
        ReDim Preserve cat(1 To narray)
        cat(narray) = Me.LbCat.List(x)  'cat is a Variant
    End If
Next x

Other listboxes are for room and department (dep):

For x = 0 To Me.LbDep.ListCount - 1
    If Me.LbDep.Selected(x) = True Then
        dep = Me.LbDep.List(x)
    End If
Next x

Now for the code that takes a long time to process: I loop in my database table (for x = 0 to ...). I start with my category (the Variant variable) and loop through all its values (for y = 1 to narray). For each value, I check if the cell in my table corresponds. If it does, check my second listbox "filter". Same for my third filter.

For x = 0 To tablerange.Columns(2).Cells.Count
    If narray = 0 Then GoTo DemNext
    For y = 1 To narray
        If tablerange.Cells(x, 2) = cat(y) Then
DemNext:
            If Room = "" Then GoTo DemNext2
            If tablerange.Cells(x, 4) = Room Then
DemNext2:
                If dep = "" Then GoTo DemNext3
                If tablerange.Cells(x, 3) = dep Then
DemNext3:
                    UserForm1.LbPreview.AddItem
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 0) = tablerange.Cells(x, 3).Value 'dep
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 1) = tablerange.Cells(x, 4).Value 'Room
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 2) = tablerange.Cells(x, 5).Value 'class
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 3) = tablerange.Cells(x, 2).Value 'cat
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 4) = tablerange.Cells(x, 7).Value 'place
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 6) = tablerange.Cells(x, 8).Value 'limit 1
                    UserForm1.LbPreview.List(UserForm1.LbPreview.ListCount - 1, 7) = tablerange.Cells(x, 9).Value 'limit 2
                End If
            ElseIf tablerange.Cells(x, 3) = dep And tablerange.Cells(x, 4) = "N/A" Then 'This line is here to display lines which have no room (N/A) but should still be displayed when the corresponding department is selected
                GoTo DemNext3
            End If
        End If
    Next y
Next x

 

[Deepak]

Pls share the sample workbook.

 

[dourpil]

Thanks for checking this out Deepak! Here's the workbook.

The part I'm trying to improve is in the "Changement" sub of the UserForm's code.

You can see the long calc-time if you bring the userform up and select "B1-B2" in the top left listbox

 

[Deepak]

Stay tuned!!

I/we loop into the same.

 

[dourpil]

Uppidi up!

Still looking for ways to improve the code!

One of which is to use "With UserForm1.LbPreview" and then and "end with". But it still keeps it slow

 

[Deepak]

I just missed it.
Pls allow sometimes. I will check & do the needful.

 

[Deepak]

Hi,

What i would suggest is..

first create a sheet test & use

Sheets("test").Range("A1:A" & UBound(narray) + 1) = Application.Transpose(narray)

to paste loop array data to there.

& So, paste all data to there then make a advance filter to get data from Table1 which would be pasted on G1 on test sheet.

Then, Use row property of column to fetch data to it.

.RowSource = "Sheet!G2:O" & lrow


This might be fast rather than loop.