Copy Excel Table filter criteria programmatically
I will in this article demonstrate a macro that copies criteria from one Excel Table and applies them to another Excel Table.
How it works
The animated image above shows selecting criteria manually in one Excel Table. An event macro then automatically copies the criteria to another table located on a different worksheet when that worksheet is activated.
It is required that both tables have the same column header names and the columns are arranged in the same order.
VBA code
'Event code located at a worksheet module Private Sub Worksheet_Activate() 'Dimension variable and declare data types Dim Value As Variant Dim c As Integer Dim Arr As Variant 'Redimension array variable Arr in order to programmatically increase array size ReDim Arr(0) 'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property. With Worksheets("Sheet1").ListObjects("Table1").AutoFilter 'Check if FilterMode is True If .FilterMode Then 'Iterate through filters For c = 1 To .Filters.Count 'Check if filter is on If .Filters(c).On Then 'Check if filter contains multiple conditions If IsArray(.Filters(c).Criteria1) Then 'Iterate through each criteria value For Each Value In .Filters(c).Criteria1 'Save criteria value to array variable Arr Arr(UBound(Arr)) = Mid(Value, 2, Len(Value)) 'Increase array size with 1 ReDim Preserve Arr(UBound(Arr) + 1) 'Continue with next criteria value Next 'Decrease array size with 1 ReDim Preserve Arr(UBound(Arr) - 1) 'Excel continues here if filter contains a single condition Else 'Save criteria value to array variable Arr Arr(UBound(Arr)) = .Filters(c).Criteria1 'Increase size of array variable Arr ReDim Preserve Arr(UBound(Arr) + 1) 'Enable error handling On Error Resume Next 'Save criteria value to array variable Arr Arr(UBound(Arr)) = .Filters(c).Criteria2 'Check if an error has occured then decrease array size with 1 If Err <> 0 Then ReDim Preserve Arr(UBound(Arr) - 1) 'Disable error handling On Error GoTo 0 'Exit If statement End If 'Enable Excel Table filter for Table2 Worksheets("Sheet2").ListObjects("Table2").Range.AutoFilter Field:=c 'Apply Excel Table filter criteria for Table2 based on variable c Worksheets("Sheet2").ListObjects("Table2").Range.AutoFilter Field:=c, Criteria1:=Arr, Operator:=xlFilterValues End If Next Else 'Iterate For c = 1 To ActiveSheet.ListObjects("Table2").Range.Columns.Count ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=c Next End If End With End Sub
Where to put the code?
- Copy above VBA code.
- Right-click on tab sheet2, you will find it at the very bottom of the Excel screen.
- Click "View Code".
- Paste VBA code to sheet module.
- Return to excel.
How to use an Excel Table name in Data Validation Lists and Conditional Formatting formulas
This article demonstrates different ways to reference an Excel defined Table in a drop-down list and Conditional Formatting. There are […]
Extract unique distinct values from a filtered Excel defined Table [UDF and Formula]
Robert Jr asks: Oscar, I am using the VBA code & FilterUniqueSort array to generate unique lists that drive Selection […]
Count unique distinct values in a filtered Excel defined Table
This article demonstrates a formula that counts unique distinct values filtered from an Excel defined Table. Debra Dalgleish described in […]
Remove common records between two data sets
This article demonstrates how to filter records occurring in only one out of two Excel defined tables. It also shows […]
Populate drop down list with filtered Excel Table values
This article demonstrates how to populate a drop down list with filtered values from an Excel defined Table. The animated […]
This article demonstrates a macro that copies values between sheets. I am using the invoice template workbook. This macro copies […]
Open Excel files in a folder [VBA]
This tutorial shows you how to list excel files in a specific folder and create adjacent checkboxes, using VBA. The […]
Split data across multiple sheets [VBA]
In this post I am going to show how to create a new sheet for each airplane using vba. The […]
Identify missing numbers in a column
The image above shows an array formula in cell D6 that extracts missing numbers i cell range B3:B7, the lower […]
Working with COMBO BOXES [Form Controls]
This blog post demonstrates how to create, populate and change comboboxes (form control) programmatically. Form controls are not as flexible […]
3 Responses to “Copy Excel Table filter criteria programmatically”
Leave a Reply
How to comment
How to add a formula to your comment
<code>Insert your formula here.</code>
Convert less than and larger than signs
Use html character entities instead of less than and larger than signs.
< becomes < and > becomes >
How to add VBA code to your comment
[vb 1="vbnet" language=","]
Put your VBA code here.
[/vb]
How to add a picture to your comment:
Upload picture to postimage.org or imgur
Paste image link to your comment.
Oscar,
Do you have a vba to hide all columns of a range except columns whose header is found in specific cells?
eg:
B1 and B2 holds header names chosen by user.
range C1 to P2 holds all headers.
Hide ALL columns except those sharing name found in B1 and B2?
Nice! I added a userform, two list boxes (sheet name, table name), a button for source and a button for destination. Userform initializes, lists sheet names and table names. The source button chooses the sheet and table name from the listbox values as the source, the user selects another sheet name and table name for the destination and submits the destination button. Now i can quickly change filters for similar sheets all in one form.
I have a related challenge, but I can't work it out by using your code. I have one table, and when a user clicks a button to perform an activity, I want to run some code that ensures that certain filters in the table are selected. I gather from your code that if I capture the selected filters in 'arr' I get the selected filters, but I can't work out how to add the required filters to 'arr'. Any suggestions appreciated... Cheers, Paul