Auto Filter with VBA based on a Range of Cells


Im currently looking for a way to accomplish my task with VBA. I would want to use auto filter based on a range of cells. I have my file attached for use. There are two tabs (data and lookup_value). The data tab has the raw data and the lookup_value has the range of cell I want to be filtered from the raw data.

Example: DATA tab

Label1      Label2      Label3       Label4
1      James      North        $3,400.00
2      Peter      South       $32,400.00
3      Andrew      West       $23,000.00
4      Sam      South       $12,000.00
5      Job              West       $2,300.00
6      Josiah      South       $12,000.00
7      Law        West       $23,000.00
8      Little      South       $45,000.00
9      William      West       $56,900.00
10      David      South       $432,000.00
11      Farai      West       $3,300.00
12      Gary      South       $334,400.00
13      Henry      West       $21,590.00
14      Kevin      South       $231,100.00
15      Katt              West       $23,120.00
16      Leon      South       $32,459.00
17      Lennon      West       $98,554.00
18      Eric              North        $349,321.00
19      Elliot      North        $34,332.00

In the lookup_value, i have a pivot table with LABEL1 in the row label. Some of the values are selected and I want the VBA to lookup the values selected from the pivot table and reflect that on the DATA tab. I also want a filter for LABEL2 to the ones equal to "North".

Your assistance is greatly appreciated.

Lennon G
Lennon GaryAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Please give this a try...

Place the following code on a Standard Module like Module1.
Sub AutoFilterData()
Dim wsData As Worksheet, wsLookup As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim x, y()
Dim critRng As Range
Dim i As Long
Application.ScreenUpdating = False

Set wsData = Worksheets("data")
Set wsLookup = Worksheets("lookup_value")
Set pt = wsLookup.PivotTables(1)
Set pf = pt.RowFields(1)
x = pf.DataRange.Value
ReDim y(1 To UBound(x, 1))
For i = LBound(x, 1) To UBound(x, 1)
    y(i) = CStr(x(i, 1))
Next i
If wsData.FilterMode Then wsData.ShowAllData
With wsData.Range("A1").CurrentRegion
   .AutoFilter 1, y, 7
   .AutoFilter 3, "North"
End With
Application.ScreenUpdating = True
End Sub

Open in new window

And place the following Sheet Activate Event Code on data Sheet Module. To do that, right click on data tab, choose View Code and paste the code given below into the opened code window.

Private Sub Worksheet_Activate()
Call AutoFilterData
End Sub

Open in new window

So as per the codes, once you filter the pivot table on lookup_value Sheet and activate the data tab, the raw data on data tab will be filtered as per the pivot table data.
Lennon GaryAuthor Commented:
this worked perfectly. just one more additional request.
I would want to copy and paste a cell value to the last row.

in the LOOKUP_VALUE tab I would want to copy A1 (cell value) and paste it to C2 to the last row, in the DATA tab.

AFTER all is done, how would I unfilter?
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
I am not sure what you are asking? Copying lookup_value!A1 and pasting to C2 to down the rows for visible cells only? This would replace the existing values from column C. Right?

To clear the confusion, upload a sample workbook with something in lookup_value!A1 cell, duplicate the data tab and copy/paste the value there manually to show the end result.

Also, will it be a part of the existing Autofiler macro or a separate macro altogether?

As far as clearing all the applied filters, you may click the button called "Clear All Filters" on data tab.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.