Filter table by range

[eggem01]

I have created a larger project including automatic updating a dashboard, a kpi with historic data, generated reports sent out by email etc. The entire project contains almost 5000 lines of code in about 175 subs. The last item on my list is to simply filter a table based upon a range created by a sub. This should be easy but I have been struggling for the past few days and its driving me crazy.

I have a sheet called "Entity" which has been created by a sub. This sheet has a table that can contain double Entitynumbers in column 4. To check this I wrote another sub that does that for me. The double Entitynumbers are placed in the same sheet at cell CM2 downwards. I just want to filter the table with these double Entitynumbers.

I have been Googling for it and I know the solution is Autofilter. Somehow I can't fully grasp it. I have been playing around a bit with this and in the original file a simple sub like this one works just fine.

Code: Select all

Sub MyAutoFilter()

ActiveSheet.Range("$A$1:$CK$699").AutoFilter _
    Field:=4, _
    Criteria1:=Array("4000894", "4664176"), _
    Operator:=xlFilterValues

End Sub

However this is not dynamic of course. My filtercriteria are in the range which obviously can vary in length..

This sub doesn't work:

Code: Select all

Sub MyAutoFilter1()

ActiveSheet.Range("$A$1:$CK$699").AutoFilter _
    Field:=4, _
    Criteria1:=ActiveSheet.Range("CM2:CM4"), _
    Operator:=xlFilterValues

End Sub

The range probably needs to be transposed or I should use a named range. Or the solution is much easier but I simply don't see it any more.

Anyone who can help me out here with a code that should do the trick. I have enclosed a xlsx.file with some dummy-info that can be used for this purpose. The idea is to filter column 4 by the range in F2:F4.

[HansV]

The problem is that AutoFilter expects an array of string values.
Here is a way to take care of that:

Code: Select all

Sub MyAutoFilter()
    Dim arr()
    Dim r As Long
    Dim m As Long
    m = Range("F" & Rows.Count).End(xlUp).Row
    ReDim arr(2 To m)
    For r = 2 To m
        arr(r) = CStr(Range("F" & r).Value)
    Next r
    Range("A1").CurrentRegion.AutoFilter _
        Field:=4, _
        Criteria1:=arr, _
        Operator:=xlFilterValues
End Sub

Alternatively, if you make sure that you store the values in the "Double" range as text values (for example by prefixing them with an apostrophe '), you can use:

Code: Select all

Sub MyAutoFilter()
    Dim m As Long
    m = Range("F" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.AutoFilter _
        Field:=4, _
        Criteria1:=Application.Transpose(Range("F2:F" & m).Value), _
        Operator:=xlFilterValues
End Sub

[eggem01]

Thanks HansV.
I will use the array-solutions since all values are numbers and not text. I tried the transpose solution but failed. I now know why.

[RMcCreavy]

This thread is the closest one I found to an issue I am currently facing.

I'm trying to combine or concatenate two strings from two different cells within the same row into an array variable to use as a filter for a table.

My data is essentially in this format: ActiveSheet.Cells(Row, 2).Value = "123" and ActiveSheet.Cells(Row, 5).Value = "456, 789, 012, 345"

Code: Select all

Dim TheRow as Long, MasterTable as ListObject, FilterList()
'I have used Row 3 to test this macro
ReDim FilterList(3 to 3)
For TheRow = 3
FilterList(TheRow) = Split(CStr(ActiveSheet.Cells(TheRow, 2).Value & ", " & ActiveSheet.Cells(TheRow, 23).Value), ",")
Next TheRow

MasterTable.Range.AutoFilter Field:=1, Criteria1:=FilterList, Operator:=xlFilterValues

I suspect the issue is with the comma delimiter? With or without the Split function, I never seem to get the proper result.

Please let me know if I should've started a new thread/topic.

[HansV]

Does this work?

Code: Select all

    Dim TheRow As Long, MasterTable As ListObject, FilterList()
    'I have used Row 3 to test this macro
    ReDim FilterList(3 To 3)
    For TheRow = 3 To 3
        FilterList(TheRow) = Split(Substitute(ActiveSheet.Cells(TheRow, 2).Value & "," & ActiveSheet.Cells(TheRow, 23).Value, " ", ""), ",")
    Next TheRow
    MasterTable.Range.AutoFilter Field:=1, Criteria1:=FilterList, Operator:=xlFilterValues

[RMcCreavy]

Substitute was not a defined function so I tried Replace, but that did not work.

[HansV]

Sorry about that mistake,

Could you attach a sample workbook without sensitive information?

[RMcCreavy]

Working on removing sensitive information, but I also just noticed that my second column has a line indentation in each cell (likely unavoidable unfortunately) and that the trim function will not remove it.

Is there an easy way to clean up the string to remove the line indentation in ActiveSheet.Cells(TheRow, 23).Value?

[RMcCreavy]

Example.xlsm

Attached is a sample workbook with the macro code.

[HansV]

The problem is that the cells in column E on Sheet1 have a line feed before the list of numbers.
This works better:

Code: Select all

Sub FilterTable()
    Application.ScreenUpdating = False
    TableName = "Table1"
    Set MasterTable = Worksheets(2).ListObjects(TableName)
    ReDim FilterList(3 To 3)
    For TheRow = 3 To 3
        FilterList(TheRow) = Split(Replace(Replace(Worksheets(1).Cells(TheRow, 2).Value & "," & _
        Worksheets(1).Cells(TheRow, 5).Value, " ", ""), vbLf, ""), ",")
    Next TheRow
    MasterTable.Range.AutoFilter Field:=1, Criteria1:=FilterList, Operator:=xlFilterValues
    Application.ScreenUpdating = True
End Sub

[RMcCreavy]

Thanks, Hans!