VBA to create an array from a filtered Excel Table

David Evans · Feb 20, 2015

So I have a Table in Excel that I filter using VBA - its all in the attached file.

I'd like to create an array from the "filtered" data - I use the Client ID to loop through a Pivot Table ....

In the example, having filtered Model for All Inclusive, I want to create an array based on the Client IDs "1,6,11,16,21 ....." (and yes i know there all 5 apart but that's cause I manufactured the data ...

)

Happy Friday, btw ...

Hui · Feb 21, 2015

David

Try this code:

Code:

Sub Model_Filtering()
Dim myArr As Variant
Dim LR As Integer

Sheets("Data").Select
Sheets.Add After:=ActiveSheet
Sheets(Sheets.Count).Name = "Temp"

Sheets("Data").Select
Range("Table1[#Headers]").Copy Sheets("Temp").Range("a1")

Sheets("Temp").Select
Sheets("Temp").Range("D2").Value = "All Inclusive"
   
Sheets("Data").Select
Range("Table1[#All]").AdvancedFilter _
  Action:=xlFilterCopy, _
  CriteriaRange:=Sheets("Temp").Range("A1:D2"), _
  CopyToRange:=Sheets("Temp").Range("F1"), _
  Unique:=False

Application.CutCopyMode = False

Sheets("Temp").Select

LR = Sheets("Temp").Range("F" & Rows.Count).End(xlUp).Row
myArr = Range(Cells(2, 6), Cells(LR, 9)).Value

' You now have an array myArr which is 32 Rows 4 columns

Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
 
End Sub

or see attached file:

David Evans · Feb 21, 2015

Thanks Hui - I always enjoy seeing the solutions you propose - I learn from them.

I ended up canning the "filtering" technique and using an IF statement to select whether the record gets placed in the array. I'll add the code later as I'm now home and don't have access to it ...
Again thanks for the help - appreciated - I'm sending you a "beer" as a token of my appreciation ...

NARAYANK991 · Feb 21, 2015

Hi David ,

Canning a feature which is extremely helpful is not really learning !

Filtering is the fastest way to get at the relevant records ; looping through 100000 records to get at 3 of them is poor programming.

See the following code if you are interested :

Code:

Sub Model_Filtering()
    Dim Rng As Range, Cell As Range
    Dim FilteredArray() As String
    Dim NumberofCells As Long
   
    ThisWorkbook.Worksheets("Data").ListObjects("Table1").Range.AutoFilter Field:=4, _
        Criteria1:="All Inclusive"
       
    On Error Resume Next
    Set Rng = ThisWorkbook.Worksheets("Data").ListObjects("Table1").ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
 
    If Rng Is Nothing Then Exit Sub
 
    NumberofCells = Rng.Cells.Count
    ReDim FilteredArray(1 To NumberofCells)
   
    i = 1
    For Each Cell In Rng.Cells
        FilteredArray(i) = Cell
        i = i + 1
    Next   
End Sub

There is a loop here , but it is a much smaller loop compared to what would be the case if you did not use a filter.

Narayan

David Evans · Feb 21, 2015

NARAYANK991 said:
Hi David ,

Canning a feature which is extremely helpful is not really learning !

Filtering is the fastest way to get at the relevant records ; looping through 100000 records to get at 3 of them is poor programming.

See the following code if you are interested :

Code:

Sub Model_Filtering() Dim Rng As Range, Cell As Range Dim FilteredArray() As String Dim NumberofCells As Long ThisWorkbook.Worksheets("Data").ListObjects("Table1").Range.AutoFilter Field:=4, _ Criteria1:="All Inclusive" On Error Resume Next Set Rng = ThisWorkbook.Worksheets("Data").ListObjects("Table1").ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Rng Is Nothing Then Exit Sub NumberofCells = Rng.Cells.Count ReDim FilteredArray(1 To NumberofCells) i = 1 For Each Cell In Rng.Cells FilteredArray(i) = Cell i = i + 1 Next End Sub

There is a loop here , but it is a much smaller loop compared to what would be the case if you did not use a filter.

Narayan

I'll be happy to check out your code next week, and thanks for the lesson in humility ....

David Evans · Feb 23, 2015

David Evans said:
I'll be happy to check out your code next week, and thanks for the lesson in humility ....

I like this code as it's a new concept for me - so I'm learning something new

Am working on integrating these ideas (Hui and Narayank991) into my project - thanks guys ...

Although my project only requires to filter out 1500 records currently, the "If" routine is not that impactful on the speed - but I like elegance more than speed, and in future, we could grow this table whereby its performance could be affected ..

Smallman · Feb 24, 2015

Hi David

How about you just take the loop right out of the mixing pot. I would steer clear of the If statement. Not sure if you have read this before. These are sage words from the late great David Hawley. VBAGoldenRules.

I particularly like the use of sheet code name and avoiding loops where necessary. IMO very good coding principles.

LOL - I was trying to reconcile the output but I see you used a randomiser. Took that puppy out to prove workings.

Code:

Option Explicit

Sub RemLoop()
Dim ar As Variant

    If Application.CountIf(Sheet1.Columns(4), "All Inclusive") = 0 Then Exit Sub
        With Sheet1.[a1].CurrentRegion
            ar = Filter(.Parent.Evaluate("transpose(if(" & .Columns(4).Address & _
            "=""All Inclusive"",row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            ar = Application.Index(.Value, Application.Transpose(ar), [{1,2,3,4}])
        End With
    Sheet2.[A2].Resize(UBound(ar, 1), 4).Value = ar
End Sub

File attached to show workings.

Take care

Smallman

David Evans · Feb 24, 2015

Thanks for the Code - will study it later this evening as part of my Continuing Education Process - appreciate your efforts and the link to further edification

NARAYANK991 · Feb 24, 2015

Hi David ,

Just to present a different opinion ; read it if you want , so that you can take a more informed decision.

http://www.techrepublic.com/blog/so...n-code-is-more-important-than-efficient-code/

http://www.ibiblio.org/pub/languages/fortran/ch1-3.html

http://forums.xkcd.com/viewtopic.php?f=12&t=9964

Marcus's code is as complex as it can get , with COUNTIF , TRANSPOSE , an array transpose ,.... ; if you ask me , for 1500 records , it would be interesting to find out how much efficiency this really contributes , when it is making understanding so much more difficult.

A loop can be understood by even a novice.

Narayan

David Evans · Feb 24, 2015

I sense a slight backing up from an earlier position - or was it an admonishment?

To be honest, the original IF statement was clean and eminently understandable. I actually changed it today to try out the other options proposed. There's no discernible performance improvement, however I did not subject it to any scientific measurement.

Thanks to all of you for your ideas and willingness to help an Excel dilettante - it's appreciated.

NARAYANK991 · Feb 24, 2015

Hi David ,

No admonitions , no backing up , no confusion ; there are many approaches to solving a problem , some are easy to understand but inefficient , some are complex and difficult to understand , at least on first reading , but efficient.

Inefficiency can be in two ways ; one is the normal one of speed of execution or utilisation of computing resources in a broader sense ; the other is the point that the programmer is not utilising all the facilities that the language offers. The counterpoint is that one need not utilise something just because it is available ; one should use it if it furthers your end. It is the like driving a car in first gear throughout ; if it is done where it is appropriate , that is fine , but on the highway , it most certainly isn't.

You have several approaches ; for now , use the one you are most comfortable with ; get to know the other approaches so that you can use them when your usual approach does not serve your purpose.

Narayan

Smallman · Feb 24, 2015

Hi

I don't think that what I provided is too difficult to grasp.

In this instance I would use my own approach as I understand it and it avoids looping which is gold as far as I am concerned.

For larger datasets and for people coming to view this thread in months, years to come the following is how to change the code I provided.

Choose the column your criteria is in Column(4) where 4 needs to change.

Choose the criteria - "All Inclusive" changes to your criteria item.

Choose the columns numbers you want to return {1,2,3,4} and place them in the curly brackets.

Make sure the sheet referencing the From sheet (Sheet1) and to sheet (Sheet2) are in line with your dataset.

There now that was not too difficult - even for a novice VBA user.

Take care

Smallman

joumar12 · May 13, 2020

Hello

I know this is an old discussion - however I just found this code and it would suit my purposes perfectly. Only problem is that I want to replace "All Inclusive" with string variable and cannot seem to make it work - any help appreciated

Edit:
Managed to solve this by myself by using chr(34) before and after variable.... Great piece of code!!

Br, jouni

eserapicos · Jul 22, 2020

NARAYANK991 said:
Hi David ,

Canning a feature which is extremely helpful is not really learning !

Filtering is the fastest way to get at the relevant records ; looping through 100000 records to get at 3 of them is poor programming.

See the following code if you are interested :

Code:

Sub Model_Filtering() Dim Rng As Range, Cell As Range Dim FilteredArray() As String Dim NumberofCells As Long ThisWorkbook.Worksheets("Data").ListObjects("Table1").Range.AutoFilter Field:=4, _ Criteria1:="All Inclusive" On Error Resume Next Set Rng = ThisWorkbook.Worksheets("Data").ListObjects("Table1").ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Rng Is Nothing Then Exit Sub NumberofCells = Rng.Cells.Count ReDim FilteredArray(1 To NumberofCells) i = 1 For Each Cell In Rng.Cells FilteredArray(i) = Cell i = i + 1 Next End Sub

There is a loop here , but it is a much smaller loop compared to what would be the case if you did not use a filter.

Narayan

***
Dear Narayan,
Why not define the "FilteredArray( ) as Variant" and simply set:
FilteredArray = Rng.Value
?
Tks for your attention if you could evaluate that

Baboutz · Sep 1, 2021

Smallman said:

Code:

Option Explicit

Sub RemLoop()
Dim ar As Variant

    If Application.CountIf(Sheet1.Columns(4), "All Inclusive") = 0 Then Exit Sub
        With Sheet1.[a1].CurrentRegion
            ar = Filter(.Parent.Evaluate("transpose(if(" & .Columns(4).Address & _
            "=""All Inclusive"",row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            ar = Application.Index(.Value, Application.Transpose(ar), [{1,2,3,4}])
        End With
    Sheet2.[A2].Resize(UBound(ar, 1), 4).Value = ar
End Sub

Hello,

A big thanks Smallman, this code is perfect for me and I was easily able to change it for my case.
I used it to fill a Listbox and it works well. I have juste one problem, it's when I have only 1 result with filter, my array is a 1Dim array and not a 2Dim array (1 row, x columns), so my datas are not in a single row but in several rows in my ListBox :

Here's my code :

Code:

    'Variables
    Dim ColVisu, WidthCol
    Dim BD
   
    'Columns to show
    ColVisu = Array(Range("Tbl[Col1]").Column, _
                    Range("Tbl[Col3]").Column, _
                    Range("Tbl[Col4]").Column, _
                    Range("Tbl[Col5]").Column, _
                    Range("Tbl[Col7]").Column)
   
    'Size of the columns in the ListBox
    WidthCol = Array(60, 60, 70, 270, 270)

    'Build of the ListBox
    Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
    Me.ListBox1.ColumnWidths = Join(WidthCol, ";")
   
    'Import filtered datas
    With Range("Tbl")
        BD = Filter(.Parent.Evaluate("transpose(if(" & .Columns(Range("Tbl[Col1]").Column).Address & _
        "=""" & ID & """,row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
        If Len(Join(BD)) = 0 Then Exit Sub 'If no results after filtering
        BD = Application.Index(.Value, Application.Transpose(BD), ColVisu)
    End With
   
    'Fill ListBox
    Me.ListBox1.List = BD

I tried some stuff to correct that but I only failed..
If you someone have any ideas, I would be very grateful !

By advance thanks and have a good day,

Baboutz

Baboutz · Sep 7, 2021

Hi everyone,

After a lot of hours, I found the solution to handle the case of 1 result : We need to use the property .Column to fill the ListBox and add Application.Transpose() before to hande the case if there is more than 1 result.
The code is :

Code:

    'Variables
    Dim ColVisu, WidthCol
    Dim BD

    'Columns to show
    ColVisu = Array(Range("Tbl[Col1]").Column, _
                    Range("Tbl[Col3]").Column, _
                    Range("Tbl[Col4]").Column, _
                    Range("Tbl[Col5]").Column, _
                    Range("Tbl[Col7]").Column)

    'Size of the columns in the ListBox
    WidthCol = Array(60, 60, 70, 270, 270)

    'Build of the ListBox
    Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
    Me.ListBox1.ColumnWidths = Join(WidthCol, ";")

    'Import filtered datas
    With Range("Tbl")
        BD = Filter(.Parent.Evaluate("transpose(if(" & .Columns(Range("Tbl[Col1]").Column).Address & _
        "=""" & ID & """,row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
        If Len(Join(BD)) = 0 Then Exit Sub 'If no results after filtering
        BD = Application.Index(.Value, Application.Transpose(BD), ColVisu)
        BD = Application.Transpose(BD)
    End With

    'Fill ListBox
    Me.ListBox1.Column = BD

This code works for every case !
I hope it can help some people in the future

Have a good day,

Baboutz

VBA to create an array from a filtered Excel Table

David Evans

Active Member

Attachments

Hui

Excel Ninja

Attachments

David Evans

Active Member

NARAYANK991

Excel Ninja

David Evans

Active Member

David Evans

Active Member

Smallman

Excel Ninja

Attachments

David Evans

Active Member

NARAYANK991

Excel Ninja

David Evans

Active Member

NARAYANK991

Excel Ninja

Smallman

Excel Ninja

joumar12

New Member

eserapicos

New Member

Baboutz

New Member

Baboutz

New Member