Populate array with large filtered range

[Journeyman3000]

Hi all.

There has got to be an easy way to do this. I am trying to populate a large sheet with many columns and many rows into an array.

The caveat is that the rows are filtered.

Assuming declarations...

LastRow = WS.Cells(Rows.Count, 2).End(xlUp).Row
arMyArray = WS.Range("A1:D" & LastRow).SpecialCells(xlCellTypeVisible)

I would rather not loop xlCellTypeVisible and take forever to loop every row and every column value into an array.

Is there an easier way to populate an array with filtered rows?


Cheers

[vba_php]

hmmmm....I bet there is an expert here that knows. have you tried selecting the entire range while recording the movements with the macro recorder? VBA has a function in it called SPLIT() but i don't think that would because you have to have a delimiter in the arguments. what about answer #2 here?

https://stackoverflow.com/questions/...a-range-in-vba

or simply, to get overloaded with options:

https://www.google.com/search?q=vba+...range+to+array

[Journeyman3000]

Thanks for the response.

Answer Number 2 in your suggested page works for a single dimension array, which is not filtered. I need my array to collect the detail from a filtered sheet.

Using the Macros recorder produces Copy and Paste Selection Code, which doesn't work to paste into an array.

However, I appreciate the time taken to provide a response.

Cheers

[vba_php]

Answer Number 2 in your suggested page works for a single dimension array, which is not filtered. I need my array to collect the detail from a filtered sheet.

so do you need a one-dim output or a 2-dim output? here is 1:

'this captures all of the values in the filtered matrix area.  the data is read top-to-bottom, column by column (left to right)
Dim DirArray As Variant
Dim DirArrayNew() As Variant
Dim x As Integer
Dim r As Range

x = 0
DirArray = Worksheets("Sheet1").Range("a2:h19").AddressLocal

For Each r In Range(CStr(DirArray))
    If Rows(r.Row).Hidden = False Then
        ReDim Preserve DirArrayNew(x)
        DirArrayNew(x) = r
        x = x + 1
    End If
Next r

and putting the data into a 2 dimensional array should be just as easy. but based on what you asked for, I'm not sure why you would want to do that, because every data point (value) represents a column and a row already.

[jindon]

I would rather not loop xlCellTypeVisible and take forever to loop every row and every column value into an array.

Is there an easier way to populate an array with filtered rows?

Prepare hidden sheet and copy filtered data to a hidden sheet and get data from there without loop.

[romperstomper]

You can also sort the source sheet on the filter columns so that you end up with as few discrete areas as possible when filtering, then loop through the areas of the visible cells, load each area into an array and then iterate that populating your master array.

[Rick Rothstein]

I think this may be the non-looping concept jindon proposed (although he may have had different coding in mind) except that I chose to copy to the active sheet (which I am assuming it the sheet with the filtered data), load the array and then delete the copied data...

Sub Test()
  Dim LastRow As Long, arMyArray As Variant
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  With Cells(LastRow + 2, "A")
    Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy .Cells(1)
    arMyArray = .CurrentRegion
    .CurrentRegion.Clear
  End With
End Sub

[Journeyman3000]

@Rick RothStein

This solution appears to be exactly what I'm looking for.

However, I am wondering if there is a way to do this in code (Memory) rather than creating a Temporary sheet.

If I had to create a temporary sheet, I would have to make it invisible - or extra hidden then have to deal with the issues related to that.

Otherwise, this is excellent. Thank you for your suggestion.

Cheers

[Rick Rothstein]

I can't mess with the original data sheet.

Even if that "messing" takes place in an unused area of the sheet? What if we created a workbook on the fly, copied the data and then retrieved it from there and then closed that temporary workbook... would that approach be acceptable?

However, I am wondering if there is a way to do this in code (Memory) rather than creating a Temporary sheet.

I guess we could loop through the cells of the visible cells and write the data to the array one cell at a time. Not sure how inefficient that might be though. Did you want to pursue that method?


You might also want to wait for jindon to come back to this thread to see if he has any ideas on how to do this wholly (and efficiently) in memory.

[Rick Rothstein]

I did not create a temporary sheet... I simply copied the data into an unused area under the existing data, loaded it into an array and then deleted what I had copied. Everything is taking place on the active sheet which I assumed is where your data is located... no extra or hidden sheets are required with the code snippet I posted.

[Journeyman3000]

I can't mess with the original data sheet. That's why I modified your code to use a temp sheet.

I tested your code to make sure it worked and my philosophy is always to 'Make it work before I make it pretty'

[Journeyman3000]

Hi Rick

I guess we could loop through the cells of the visible cells and write the data to the array one cell at a time. Not sure how inefficient that might be though. Did you want to pursue that method?

Absolutely not. This entire exercise is to avoid looping through millions of cells.

If I have no choice but to create a temporary sheet then I will have to live with it. I've made it work based on your input.

My end goal is to make an array of only visible rows with non-concurrent columns (e.g. B:B, H:H,Z:Z). But for all my research I've not found an adequate solution to this problem, except by looping, which bites. Makes me cry.

Thanks for help.

Cheers

[jindon]

If you know the filtered criteria/column, it could be done.

[jindon]

I said

If you know the filtered criteria/column, it could be done.

Means if you know the criteria, it could all be done within a memory. No helper sheet.

[Journeyman3000]

I tried this:

WSOrigin.Range("A:A, C:C").CurrentRegion.SpecialCells(xlVisible).Copy WSTemp.Cells(1)

But no happiness.

My guess is I would have to loop through the temp sheet and remove the columns I don't need. more ugliness, but what else can I do.

Cheers

[jindon]

with WSTemp.Cells(1).currentregion
    myarray = application.index(.value, evaluate("row(1:" & .rows.count & ")"),array(2,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26))
end with

[Journeyman3000]

Mate!

Aside from the requirement to use a helper sheet, this is fantastic. I even set the numbering to see if it auto ordered the sheets, which it does.

Excellent. Thank you for this.

[Journeyman3000]

I used the helper sheet to avoid using the original sheet as suggested

This is the code

Sub BuildVisibleArray()
Dim LastRow As Long
Dim varVisibleArray As Variant
Dim WSOrigin As Worksheet
Dim WSTemp As Worksheet
Dim WSDestination As Worksheet
Dim rngTemp As Range
  
'Period         '28 (AB)
'LastName       '8  (H)
'LineStatus     '32 (AF)
'Group          '21 (U)
'Task           '25 (Y)
'ActualHours    '18 (R)
'Charge         '5  (E)
  
    'Set worksheets
    Set WSOrigin = ThisWorkbook.Worksheets("Origin")
    Set WSTemp = ThisWorkbook.Worksheets("TempArray")
    Set WSDestination = ThisWorkbook.Worksheets("Destination")
    
    'Remove data
    LastRow = WSDestination.Cells(Rows.Count, 3).End(xlUp).Row
    If LastRow <= 17 Then LastRow = 17
    WSDestination.Range("17:" & LastRow).Delete
    
    'Get the last row for the origin range.
    LastRow = WSOrigin.Cells(Rows.Count, 2).End(xlUp).Row
    
    'Copy visible range to Temp sheet then Create the Array from the new range
    With WSOrigin.Cells(LastRow + 2, "A")
        WSOrigin.Range("A:A").CurrentRegion.SpecialCells(xlVisible).Copy WSTemp.Cells(1)
        varVisibleArray = WSTemp.Range("A1").CurrentRegion
    End With
    
    'Convert Range to array and then print to output range - this will also reorder the required columns
    With WSTemp.Cells(1).CurrentRegion
        varVisibleArray = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(28, 8, 32, 21, 25, 18, 5))
        Call PrintArray(varVisibleArray, WSDestination.Range("B17"))
    End With
End Sub

Sub PrintArray(varArrayInput As Variant, rngOutput As Range)
'outputs array to sheet
    rngOutput.Resize(UBound(varArrayInput, 1), UBound(varArrayInput, 2)) = varArrayInput
End Sub

I tried making the varVisibleArray from the origin sheet, but I couldn't get it to work

[Peter_SSs]

I used the helper sheet to avoid using the original sheet as suggested

I tried making the varVisibleArray from the origin sheet, but I couldn't get it to work

If I have understood correctly then I don't think that you need a helper sheet and I don't think you even need to get the visible cells into an array as they can be transferred directly to the destination worksheet. My suggestion does have a double loop but it it looping within memory only and only relating to the visible rows in one column so I don't think you will find a performance problem.

Give this a try with a copy of your workbook

Sub BuildVisibleArray_v2()
  Dim LastRow As Long
  Dim WSOrigin As Worksheet
  Dim WSDestination As Worksheet
  Dim itm As Variant
  Dim aRws As Variant
  Dim aCols As Variant
  Dim visrws As String
  Dim i As Long
  
  Const myCols As String = "28 8 32 21 25 18 5"
    
  'Period         '28 (AB)
  'LastName       '8  (H)
  'LineStatus     '32 (AF)
  'Group          '21 (U)
  'Task           '25 (Y)
  'ActualHours    '18 (R)
  'Charge         '5  (E)
  
  'Set worksheets
  Set WSOrigin = ThisWorkbook.Worksheets("Origin")
  Set WSDestination = ThisWorkbook.Worksheets("Destination")
  
  'Remove data
  LastRow = WSDestination.Cells(Rows.Count, 3).End(xlUp).Row
  If LastRow <= 17 Then LastRow = 17
  WSDestination.Range("17:" & LastRow).Delete
  
  'Get the last row for the origin range.
  LastRow = WSOrigin.Cells(Rows.Count, 2).End(xlUp).Row
  
  'Loop in memory to list visible rows
  For Each itm In Split(WSOrigin.Range("B1:B" & LastRow).SpecialCells(xlVisible).EntireRow.Address(0, 0), ",")
    For i = Split(itm, ":")(0) To Split(itm, ":")(1)
      visrws = visrws & " " & i
    Next i
  Next itm
  
  'Make row and column arrays
  aRws = Application.Transpose(Split(Mid(visrws, 2)))
  aCols = Split(myCols)
  
  'Transfer the visible cell values to Destination directly
  WSDestination.Range("B17").Resize(UBound(aRws), UBound(aCols) + 1).Value = Application.Index(WSOrigin.Cells, aRws, aCols)
End Sub

[Journeyman3000]

Thank you so much Peter (And Jindon), and all other who responded to this challenge.

This works very well, and is a ton faster than Before.

I will now close this issue as this question is answered (so very brilliantly!)

Thank you.

[Peter_SSs]

Thank you so much Peter (And Jindon), and all other who responded to this challenge.

This works very well, and is a ton faster than Before.

You're welcome. Glad we could help.