• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to create an array from a filtered Excel Table

David Evans

Active Member
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 ... :rolleyes:)

Happy Friday, btw ... :cool:
 

Attachments

Hui

Excel Ninja
Staff member
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:
 

Attachments

David Evans

Active Member
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 ... o_O
 

NARAYANK991

Excel Ninja
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

Active Member
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

Active Member
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 ... :awesome:
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

Excel Ninja
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
 

Attachments

David Evans

Active Member
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 :DD
 

NARAYANK991

Excel Ninja
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/software-engineer/why-clean-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

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

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

Excel Ninja
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

Excel Ninja
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

New Member
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
 
Last edited:
  • Like
Reactions: Hui

eserapicos

New Member
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
 
Top