Is it possible to do the equivalent of this with data in a worksheet?
I want to be able to select one or more values from two different columns.
For example , in a State Column, I want to be able to select NY, HI, CA
and in a Grocery Store Column, I want to be able to select, Safeway and
Lucky's
However, when I apply an advanced filter, selecting NY, HI, and CA, I find
that I am getting other Grocery stores, simply because the advanced filter
wants to give me EVERYTHING from NY, HI and CA regardless of my 2nd column
criteria.
Essentially, I want to be able to say something like State IN("NY", "HI",
"CA") AND [Grocery Store] IN("Safeway", "Lucky's")
Why can't I just hook it up to some external data - you ask? Because I
won't have the option to setup an external data source for this Application.
Phillip London UK
This VBA solution works for me using the following assumptions
Sheet1 contains a database starting in cell A1
Database headings are in row 1
The first 2 headings are
A1 = State
B1 = Store
etc
Make these headings bold so as to tell Excel that they are headings
and not data
Continue with as many other headings as you want in row 1
The first record starts in A2, B2 etc
eg A2 = NY B2 = Safeways etc
A3 = CA B3 = WalMart etc
Select from Cell A1 to bottom right corner of data
and press Ctrl F3 Type the name Database press enter
On sheet2
In A1 Type State
In B1 Type Store
Make them bold
Select cell A1 in sheet2 and press Ctrl F3
In the Name box type Criteria
In the Refers to box type
=OFFSET(Sheet2!$A$1,0,0,COUNTA(Sheet2!$A:$A),2)
Press enter
This is a dynamic range name which expands and contracts
according to the data below the headings
From the Form toolbar draw out a button and click ok
Once you have pasted the code below the button will toggle between
running the in place advanced filter and removing the filter
To run :=
Select the states and stores you want with the mouse
and click the button
Press Alt F11
Insert a standard module
Paste the code below
Option Base 1
Dim Db As Range
Dim Records As Range
Dim Crit As Range
Dim States() As String
Dim Stores() As String
Dim State As Range
Dim Store As Range
Dim j As Long
Dim x As Long
Dim y As Long
Dim z As Long
Const STATECOLUMNNUMBER As Long = 1
Const STORECOLUMNNUMBER As Long = 2
Sub Button1_Click()
Dim ar As Range
Dim Rselection As Range
Set Db = Range("Database")
If Db.Rows.Count = 1 Then Exit Sub
If FilterMode Then
Db.Parent.ShowAllData
Exit Sub
End If
Set Rselection = Selection
If Rselection Is Nothing Then Exit Sub
Set Crit = Range("Criteria")
Crit.Parent.Rows("2:100").Clear
Set State = Db.Columns(STATECOLUMNNUMBER)
Set Store = Db.Columns(STORECOLUMNNUMBER)
x = 0
y = 0
z = 0
If Rselection.Areas.Count = 1 Then
ValidateOneArea Rg:=Rselection
Else
For Each ar In Rselection.Areas
ValidateOneArea Rg:=ar
Next
End If
For Each ele In States
For j = 1 To y
Crit.Columns(STATECOLUMNNUMBER).Cells(1 + j + z) = ele
Next
z = z + y
Next
z = 1
For j = 1 To x
For Each ele In Stores
Crit.Columns(STORECOLUMNNUMBER).Cells(z + 1) = ele
z = z + 1
Next
Next
Db.Cells(1, 1).Select
Db.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Crit
End Sub
Sub ValidateOneArea(ByRef Rg As Range)
Dim cl As Range
Dim i As Range
For Each cl In Rg
Set i = Application.Intersect(State, cl)
If Not (i Is Nothing) Then
x = x + 1
ReDim Preserve States(x)
States(x) = cl.Value
End If
Set i = Application.Intersect(Store, cl)
If Not (i Is Nothing) Then
y = y + 1
ReDim Preserve Stores(y)
Stores(y) = cl.Value
End If
Next
End Sub
