VBA Select Filtered Cells

Question

I have a UserForm in a sheet. In this form I have 6 combobox.

This combobox are populated from a sheet with 6 columns, each column goes to a combobox. After each combobox is selected, I make a filter at this sheet and repopulate the next one.

I'll give you an example to try to make it more clear.

This sheet have ALL the possible combinations for all this itens. For example: For each building in a street I have a row with all the same 5 first items and the last one changes.

When the user opens the form I populate the first combobox with the first column of the sheet (I do a routine to get unique items). When the user changes the first combobox, I apply a filter to the sheet in the first column and then I populate the second combobox with the filtered sheet.

My problem is how to get the filtered range. I'm doing this:

lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row
lFiltered = Sheets("SIP").Range("A2:F" & lastRow).SpecialCells(xlCellTypeVisible).Cells

It works fine. But when I apply a filter and it hides, for exemple, only the row 10, the lFiltered variable will return only until row 9. It breaks on the first hidden row and does not return any row after that.

The solution I came up with is to do a foreach with every row and check if its visible or not, but the code gets really, really slow. It takes up to 10 seconds to populate each combobox.

Anyone have any idea how can I work around this issue?

Thank you very much.

-- edit --

Here is the important part of the code

Dim listaDados As New Collection
Dim comboList() As String
Dim currentValue As String
Dim splitValue() As String
Dim i As Integer
Dim l As Variant
Dim lFiltered As Variant
Dim lastRow As Integer

'Here I found the last row from the table
lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row
'I do this because when the filter filters everything, lastRow = 1 so I got an erros on lFiltered range, it becames Range("A2:F1")
If lastRow < 2 Then
    lastRow = 2
End If
'Here I get an array with all the visible rows from the table -> lFiltered(row, column) = value
lFiltered = Sheets("SIP").Range("A2:F" & lastRow).SpecialCells(xlCellTypeVisible).Cells
'I have duplicated entries, so I insert everything in a Collection, so it only allows me to have one of each value
on error resume next
For i = 1 To UBound(lFiltered)
    currentValue = Trim(lFiltered(i, column))
    If currentValue <> 0 Then
        If currentValue <> "" Then
            'Cammel case the string
            currentValue = UCase(Left(currentValue, 1)) & LCase(Mid(currentValue, 2))
            'Upper case the content in between "( )"
            splitValue = Split(currentValue, "(", 2)
            currentValue = splitValue(0) & "(" & UCase(splitValue(1))
            'Insert new item to the collection
            listaDados.Add Item:=currentValue, Key:=currentValue
        End If
    End If
Next i
i = 1
'Here I copy the collection to an array
ReDim Preserve comboList(0)
comboList(0) = ""
For Each l In listaDados
    ReDim Preserve comboList(i)
    comboList(i) = l
    i = i + 1
Next l

'Here I assign that array to the combobox
formPerda.Controls("cGrupo" & column).List = comboList

--- edit ---

Here is how I managed the code to work the way I want.

'Get the last row the filter shows
lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row
'To avoid to get the header of the table
If lastRow < 2 Then
    lastRow = 2
End If
'Get the multiple range showed by the autofilter
Set lFilteredAux = Sheets("SIP").Range("A2:F" & lastRow).Cells.SpecialCells(xlCellTypeVisible)

'Check if there is more than 1 no contiguous areas
If Sheets("SIP").Range(lFilteredAux.Address).Areas.Count > 1 Then
    'If Yes, do a loop through the areas
    For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
        'And add it to the lFiltered array
        ReDim Preserve lFiltered(i - 1)
        lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i)
    Next i
Else
    'If there is only one area, it goes the old way
    ReDim lFiltered(0)
    lFiltered(0) = Sheets("SIP").Range(lFilteredAux.Address)
End If

Now I have the lFiltered array a little different than the way I was using, but I adapted my foreach to work like this:

For i = 0 To UBound(lFiltered)
        For j = 1 To UBound(lFiltered(i))
            currentValue = Trim(lFiltered(i)(j, columnNumber))
        next j
next i

Thanks a lot! =D

What is the value of lastRow when lFiltered returns only up to row 9? — Excel Developers
the lastRow value is always correct. For example, I did a test right now and I got almost every row hidden, exept row 79 and rows from 763 to 929. the lastRow value was 929, but the lFiltered variable only got the row 79. It's like the "range" method stops on the first gap. And I don't know how to work around it. — hend
Do you declare lFiltered as a Range variable? The name is confusing as it implies that is a a type Long variable, but that won't work in your code - you would need to use a Set as Gary's Student noted. — Excel Developers
I declare the lFiltered variable as Variant. The lFiltered value after the interaction is an array with two dimensions. The first one is the row and the second is the column For example: lFiltered(1,2) gives me the value of the cell in the first row and second column. lFiltered does not return an range. It's and array of values. You think I should be doing this different? I'll edit my question and add a part of my code to show you what I am doing. And also a part of the table where are the values. — hend
I think I understood what you were saying and it's starting to work great. I changed my code to do this: Set lFilteredAux = Sheets("SIP").Range("A2:F" & ultimaLinha).Cells.SpecialCells(xlCellTypeVisible) But I can't do: lFiltered = Sheets("SIP").Range(lFilteredAux.Address) Because it won't work when I have, for example: lFilteredAux = "$A$2:$F$4,$A$8:$F$10" It will only work if I have one range, not multiple ranges. What can I do to transform the range I have in an array so I can perform an foreach? — hend

josh waxman josh waxman · Accepted Answer · 2015-06-14T11:22:17

The obvious performance sink here is that you are using ReDim Preserve in a tight loop.

To explain, that little ReDim Preserve statement does a lot of work. If you have an array of size 4 and you ReDim it to size 5, it allocates 5 spaces and also copies over the 4 values from the previous array. If you then ReDim it to size 6, it allocates 6 spaces and also copies over the 5 values from the previous array.

Say you have 1000 values total. When writing the code, you thought that you were merely allocating 1000 elements in the array and copying them over. This would be in linear time, an O(n) operation. In truth, you were allocating 1 + 2 + 3 + 4 ... + 1000 elements = allocating and copying 500,000, which would be in polynomial time, an O(n^2) operation.

The solution is either:

1) Outside the loop, figure out the size of your array and then only ReDim Preserve once.

That is, first:

Dim totalSize as Long, i as Long 
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
    totalSize += 1
Next I

And once you have the size:

ReDim Preserve lFiltered(totalSize - 1)
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
     lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i)
Next i

2) Instead of using an array, which needs resizing, and whose ReDim Preserve requires a specific size, use a Collection. Internally, the Collection is implemented as something like a linked list, such that adding an item happens in constant time (so O(1) for each operation and so O(n) total for inserting all n items).

Dim c as New Collection
ReDim Preserve lFiltered(totalSize - 1)
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
     c.Add Sheets("SIP").Range(lFilteredAux.Address).Areas(i)
Next i

VBA Select Filtered Cells

2 Answers