VBA Visible Range in a UserForm Listbox

[MichaelRSnow]

Hi

I've been searching the forums for some vba code which takes a visible range of cells/columns from a worksheet and places them within a Listbox held within a UserForm
The below code appears to do part of that (product_baseline is the spreadsheet, ShowProducts is the ListBox)
Issue 1: The below is it's not visible cells, it copies everything? any ideas how to apply the .SpecialCells(12) logic to the below?
Issue 2: Appears to cap at 10 columns, if i add a further "ShowProducts.List(i - 1, 10) = .Cells(i, 11).Value" to the code it fails with an could not set the list property value error?

Dim cell As Range
Dim MyArr  As Variant, i As Long

' intialize array to high number of elements at start

ShowProducts.ColumnWidths = "38.25;80.75;153;68;110.5;97.75;246.5;28.5;28.5"
ShowProducts.Clear 'CLEAR THE LIST BOX BEFORE REBUILDING THE LIST
With Product_baseline
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row 'FIND THE LAST ROW NUMBER
For i = 1 To LastRow 'ADD ITEMS TO THE LISTBOX
 ShowProducts.AddItem .Cells(i, 1).Value 'ADD NEW ROW
 ShowProducts.List(i - 1, 1) = .Cells(i, 2).Value 'ADD TO ADJACENT COLUMNS ON SAME ROW
 ShowProducts.List(i - 1, 2) = .Cells(i, 3).Value
 ShowProducts.List(i - 1, 3) = .Cells(i, 4).Value
 ShowProducts.List(i - 1, 4) = .Cells(i, 5).Value
 ShowProducts.List(i - 1, 5) = .Cells(i, 6).Value
 ShowProducts.List(i - 1, 6) = .Cells(i, 7).Value
 ShowProducts.List(i - 1, 7) = .Cells(i, 8).Value
 ShowProducts.List(i - 1, 8) = .Cells(i, 9).Value
 ShowProducts.List(i - 1, 9) = .Cells(i, 10).Value
Next i
End With

 

[Norie]

Is the range filtered?

 

[MichaelRSnow]

Yes its filtered

 

[Fluff]

The AddItems method is limited to 10 columns, so if you want more columns you will need to use .List, rather than .AddItem.
The simplest option would be to copy the filtered range to a new sheet & then pull that data directly into the listbox

 

[jasonb75]

I had to do something simliar a while back, it took me a few days of googling to resolve it. This is the method that I used (edited to match the code in post #1).
With blocks and range / sheet variables omitted to try and make it easier to follow.

Dim LastRow As Long, lasttmp As Long
Sheets("Temp").Range("A1:I" & lasttmp).ClearContents ' clear old temporary data before starting

LastRow = Product_Baseline.Cells(Rows.Count, 1).End(xlUp).Row ' find last row of source sheet

Product_Baseline.Range("A1:I" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("A1") ' copy filtered data to temp sheet

lasttmp = Sheets("Temp").Cells(Rows.Count, 1).End(xlUp).Row ' find last row of temp sheet

With ShowProducts
    .ColumnCount = 9
    .ColumnWidths = "38.25;80.75;153;68;110.5;97.75;246.5;28.5;28.5"
    .Clear
    .RowSource = "Temp!" & Sheets("Temp").Range("A1:I" & lasttmp).Address ' set data source as temp sheet
End With

Note that the RowSource range at the end needs to be written in worksheet formula format of Temp!A1:I???, not in vba format Sheets("Temp").Range("A1:I???")

I'm sure that there is room for significant improvement, but it should give you something to work with.

 

[MichaelRSnow]

Thanks all, let me take this away, see how that works and i'll come back to you shortly

 

[Norie]

What you can do is create a function that takes a range and from the visible cells, which will most likely consist of non-contiguous ranges, and create an array from them.

That array can then be used to populate the listbox.

 

[MichaelRSnow]

@jasonb75 was very simple, and creating a temp copy of the sheet isn't a problem for this solution so work fine. Thanks all, I knew one of you would have a simple solution to this.

 

[jasonb75]

You're welcome

Norie has my attention though, I did try dumping the filtered range into an array but kept getting errors of various types. I thought that this might have been down to the 10 column limit, but it could have just as easily been incorrect method.

I didn't try it as a function, so that could have been the answer that I missed.

 

[Norie]

If you try putting range that consists of non-contiguous areas, which is what you would typically have after filtering, only the first area will be put in the array.

For example if the range consisted of A2:D20, A40:D45 and A56:D567 and you tried this,

arrData = Range("A2:D20, A40:A45, A56:A5647").Value

then arrData would only be populated with the values from A2:D20.

Anyway, here's function that should create an array with all the values from a range consisting on non-contiguous areas.

Function ConsolidateAreasToArray(rng As Range) As Variant
Dim rngArea As Range
Dim arrIn As Variant
Dim arrOut As Variant
Dim idxCol As Long
Dim idxRow As Long
Dim cnt As Long

    
    For Each rngArea In rng.Areas
    
        If IsArray(arrOut) Then
            ReDim Preserve arrOut(1 To rng.Columns.Count, 1 To UBound(arrOut, 2) + rngArea.Rows.Count)
        Else
            ReDim arrOut(1 To rng.Columns.Count, 1 To rng.Rows.Count)
        End If
        
        arrIn = rngArea.Value
        
        For idxRow = LBound(arrIn, 1) To UBound(arrIn, 1)
            cnt = cnt + 1
            For idxCol = LBound(arrIn, 2) To UBound(arrIn, 2)

                arrOut(idxCol, cnt) = arrIn(idxRow, idxCol)
            Next idxCol
        Next idxRow
        
    Next rngArea
    
    ConsolidateAreasToArray = arrOut
    
End Function