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

 

[jasonb75]

How would you propose passing the array back to the lisbox, Norie?

I tried a simple test using a filtered range with

With UserForm1.ListBox1
    .ColumnCount = 7
    .Clear
    .List = ConsolidateAreasToArray(Selection.SpecialCells(12))
End With
UserForm1.Show

Which populates the listbox with the correct data, but it has been incorrectly transposed.
Attempting to transpose the range being passed to the function results in RTE 424

 

[MichaelRSnow]

This is very useful Norie, will try this method also when I get time

 

[jasonb75]

Ignore post #11, I was trying to transpose the range before passing it to the function, I just realised that transposing the entire function works fine.

 

[Norie]

Oops, forgot to transpose the array at the end of the function.

Mind you, not essential when using it to populate a listbox, since you can use Column instead of List.

 

[MichaelRSnow]

@jasonb75 @Norie

Is there an alternative way to do this without using the copy method i.e. value = value

I'm finding that the copy method every 1 in 25ish attempts hangs for 10 seconds, appears to be a known issue with copying data?

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

 

[Norie]

The code I posted doesn't use Copy.

 

[MichaelRSnow]

I was unable to use your approach Norie as my original range of data went from A1 to BB & lastrow (682) , but I only wanted 12 of those columns in ListBox, so I only copied those columns over to the Temp location

ProductDetails.Range("A1:A" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("A1") ' copy filtered data to temp sheet
                    ProductDetails.Range("G1:G" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("B1") ' copy filtered data to temp sheet
                    ProductDetails.Range("P1:P" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("C1") ' copy filtered data to temp sheet
                    ProductDetails.Range("R1:R" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("D1") ' copy filtered data to temp sheet
                    ProductDetails.Range("S1:S" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("E1") ' copy filtered data to temp sheet
                    ProductDetails.Range("W1:W" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("F1") ' copy filtered data to temp sheet
                    ProductDetails.Range("X1:X" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("G1") ' copy filtered data to temp sheet
                    ProductDetails.Range("Y1:Y" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("H1") ' copy filtered data to temp sheet
                    ProductDetails.Range("AD1:AD" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("I1") ' copy filtered data to temp sheet
                    ProductDetails.Range("AG1:AG" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("J1") ' copy filtered data to temp sheet
                    ProductDetails.Range("AN1:AN" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("K1") ' copy filtered data to temp sheet
                    ProductDetails.Range("AZ1:AZ" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("L1") ' copy filtered data to temp sheet
                    ProductDetails.Range("BB1:BB" & LastRow).SpecialCells(xlVisible).Copy Sheets("Temp").Range("M1") ' copy filtered data to temp sheet

 

[MichaelRSnow]

Remaining code used in current approach

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

        With ShowProducts
                        .ColumnCount = 13
                        .ColumnWidths = "25;40;85;155;75;115;100;250;30;30;30;250;150"
                        .RowSource = vbNullString
                        .Clear
                        .RowSource = "Temp!" & Sheets("Temp").Range("A1:M" & lasttmp).Address ' set data source as temp sheet
                    End With

 

[jasonb75]

Norie's method would be more efficient if the code can be modified to do what you need.
I'll leave the changes to Norie, if I try to do it then it would be like engraving glass with a sledgehammer, a lack of precision and finesse ?