Greetings All,

I set up a filter similar to Debra Dalgleish's Filter for Date Range,
using a numeric range instead. This works fine.

There is student data on a sheet named "Students," and filter criteria
(grade levels 6 through 12) are on a sheet named "Schedules". On the
"Schedules sheet are separate ranges for different class periods--each
cell contains data validation with its source set =AbbNames, which is a
column on the "Students" sheet. This allows the user to select student
names instead of typing them.

With the filter on, however, the listboxes still show the entire list
of students. For ex, if grades 11 and 12 are selected, all students in
the school are given in the drop down list. Why? Is there a way to
fix this and limit the contents of the list box to the filtered names?

Thanks much,
Arnold

The named range doesn't change when a filter is applied to the range.
You could add a bit more code, and create a list of names after the
filter is applied, then rename the revised range. For example, in the
sample workbook:

'==============
'create unique list of products
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=wsO.Range("G1:H2"), _
CopyToRange:=wsDL.Range("G1"), Unique:=True
wsDL.Range("G1").CurrentRegion.Sort _
Key1:=wsDL.Range("G2"), Order1:=xlAscending, header:=xlYes
ThisWorkbook.Names.Add Name:="Products", _
RefersTo:=wsDL.Range("G1").CurrentRegion
'==============

When you remove the filter, add code to create the full list of names,
and rename it.

'===================
''create unique list of products
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:="", _
CopyToRange:=wsDL.Range("G1"), Unique:=True
wsDL.Range("G1").CurrentRegion.Sort _
Key1:=wsDL.Range("G2"), Order1:=xlAscending, header:=xlYes
ThisWorkbook.Names.Add Name:="Products", _
RefersTo:=wsDL.Range("G1").CurrentRegion
'====================

Arnold wrote:
> Greetings All,
>
> I set up a filter similar to Debra Dalgleish's Filter for Date Range,
> using a numeric range instead. This works fine.
>
> There is student data on a sheet named "Students," and filter criteria
> (grade levels 6 through 12) are on a sheet named "Schedules". On the
> "Schedules sheet are separate ranges for different class periods--each
> cell contains data validation with its source set =AbbNames, which is a
> column on the "Students" sheet. This allows the user to select student
> names instead of typing them.
>
> With the filter on, however, the listboxes still show the entire list
> of students. For ex, if grades 11 and 12 are selected, all students in
> the school are given in the drop down list. Why? Is there a way to
> fix this and limit the contents of the list box to the filtered names?
>
> Thanks much,
> Arnold
>


--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

Thanks to the author herself--Debra,

I input the code into your example and it worked. It did not work in
mine, which is laid out a little different. I'm only getting the first
name from the 'database' (from IV2 on a "Students" sheet) put into the
top row of the filtered list (A1 on a "NameList" sheet). No other
names are included. I hate to say how much time I've spent on this...

Here are the sheets:

Students--contains the data
GradeList--contains the categories of grade levels (6 through 12)
NameList--to hold the filtered list of names from code
Schedules--contains the filter criteria, range is J1:K2

Here are the defined ranges:
AllGrades=OFFSET(Students!$G$1,0,0,COUNTA(Students!$G:$G),1)
Abbreviated=OFFSET(Students!$J$1,1,0,COUNTA(Students!$J:$J)-1,1)
Database=OFFSET(Abbreviated,0,246,COUNTA(Abbreviated),1)
GradeList=OFFSET(GradeList!$A$2,0,0,COUNT(GradeList!$A:$A),1)
NameList=NameList!$A$1:$A$119

Here's the code:

Sub ApplyFilter()
Dim wsGL As Worksheet
Dim wsNL As Worksheet
Dim wsO As Worksheet
Dim rngAD As Range

Set wsGL = Sheets("GradeList")
Set wsNL = Sheets("NameList")
Set wsO = Sheets("Students")
Set WsC = Sheets("Schedules")
Set rngAD = wsO.Range("AllGrades")

'update the list of dates
wsGL.Range("A1").CurrentRegion.ClearContents
'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
rngAD.AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:="", _
CopyToRange:=wsGL.Range("A1"), unique:=True
wsGL.Range("A1").CurrentRegion.Sort _
Key1:=wsGL.Range("A2"), Order1:=xlAscending, header:=xlYes
'filter the list
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=WsC.Range("J1:K2"), unique:=False


'create unique list of students
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=WsC.Range("J1:K2"), _
CopyToRange:=wsNL.Range("A1"), unique:=True
wsNL.Range("A1").CurrentRegion.Sort _
Key1:=wsNL.Range("A2"), Order1:=xlAscending, header:=xlYes
ThisWorkbook.Names.Add Name:="NameList", _
RefersTo:=wsNL.Range("A1").CurrentRegion


End Sub

Sub RemoveFilter()

Dim wsGL As Worksheet
Dim wsNL As Worksheet
Dim wsO As Worksheet
'Dim rngAD As Range

Set wsGL = Sheets("GradeList")
Set wsNL = Sheets("NameList")
Set wsO = Sheets("Students")
Set WsC = Sheets("Schedules")
'Set rngAD = wsO.Range("AllGrades")

''create unique list of products
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:="", _
CopyToRange:=wsNL.Range("A1"), unique:=True
wsNL.Range("A1").CurrentRegion.Sort _
Key1:=wsNL.Range("A2"), Order1:=xlAscending, header:=xlYes
ThisWorkbook.Names.Add Name:="NameList", _
RefersTo:=wsNL.Range("A1").CurrentRegion

On Error Resume Next
Sheets("Students").Select
ActiveSheet.ShowAllData
Sheets("Schedules").Select
' ActiveSheet.ShowAllData
End Sub

Any help would be greatly appreciated.

In my sample, the Database range contains all the data in the Orders
sheet (currently Orders!A458). In your description, Database is one
column. Perhaps if you redefine it to include your data, the code will
work correctly.


Arnold wrote:
> Thanks to the author herself--Debra,
>
> I input the code into your example and it worked. It did not work in
> mine, which is laid out a little different. I'm only getting the first
> name from the 'database' (from IV2 on a "Students" sheet) put into the
> top row of the filtered list (A1 on a "NameList" sheet). No other
> names are included. I hate to say how much time I've spent on this...
>
> Here are the sheets:
>
> Students--contains the data
> GradeList--contains the categories of grade levels (6 through 12)
> NameList--to hold the filtered list of names from code
> Schedules--contains the filter criteria, range is J1:K2
>
> Here are the defined ranges:
> AllGrades=OFFSET(Students!$G$1,0,0,COUNTA(Students!$G:$G),1)
> Abbreviated=OFFSET(Students!$J$1,1,0,COUNTA(Students!$J:$J)-1,1)
> Database=OFFSET(Abbreviated,0,246,COUNTA(Abbreviated),1)
> GradeList=OFFSET(GradeList!$A$2,0,0,COUNT(GradeList!$A:$A),1)
> NameList=NameList!$A$1:$A$119
>
> Here's the code:
>
> Sub ApplyFilter()
> Dim wsGL As Worksheet
> Dim wsNL As Worksheet
> Dim wsO As Worksheet
> Dim rngAD As Range
>
> Set wsGL = Sheets("GradeList")
> Set wsNL = Sheets("NameList")
> Set wsO = Sheets("Students")
> Set WsC = Sheets("Schedules")
> Set rngAD = wsO.Range("AllGrades")
>
> 'update the list of dates
> wsGL.Range("A1").CurrentRegion.ClearContents
> 'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
> rngAD.AdvancedFilter _
> Action:=xlFilterCopy, CriteriaRange:="", _
> CopyToRange:=wsGL.Range("A1"), unique:=True
> wsGL.Range("A1").CurrentRegion.Sort _
> Key1:=wsGL.Range("A2"), Order1:=xlAscending, header:=xlYes
> 'filter the list
> wsO.Range("Database").AdvancedFilter _
> Action:=xlFilterInPlace, _
> CriteriaRange:=WsC.Range("J1:K2"), unique:=False
>
>
> 'create unique list of students
> wsO.Range("Database").AdvancedFilter _
> Action:=xlFilterCopy, CriteriaRange:=WsC.Range("J1:K2"), _
> CopyToRange:=wsNL.Range("A1"), unique:=True
> wsNL.Range("A1").CurrentRegion.Sort _
> Key1:=wsNL.Range("A2"), Order1:=xlAscending, header:=xlYes
> ThisWorkbook.Names.Add Name:="NameList", _
> RefersTo:=wsNL.Range("A1").CurrentRegion
>
>
> End Sub
>
> Sub RemoveFilter()
>
> Dim wsGL As Worksheet
> Dim wsNL As Worksheet
> Dim wsO As Worksheet
> 'Dim rngAD As Range
>
> Set wsGL = Sheets("GradeList")
> Set wsNL = Sheets("NameList")
> Set wsO = Sheets("Students")
> Set WsC = Sheets("Schedules")
> 'Set rngAD = wsO.Range("AllGrades")
>
> ''create unique list of products
> wsO.Range("Database").AdvancedFilter _
> Action:=xlFilterCopy, CriteriaRange:="", _
> CopyToRange:=wsNL.Range("A1"), unique:=True
> wsNL.Range("A1").CurrentRegion.Sort _
> Key1:=wsNL.Range("A2"), Order1:=xlAscending, header:=xlYes
> ThisWorkbook.Names.Add Name:="NameList", _
> RefersTo:=wsNL.Range("A1").CurrentRegion
>
> On Error Resume Next
> Sheets("Students").Select
> ActiveSheet.ShowAllData
> Sheets("Schedules").Select
> ' ActiveSheet.ShowAllData
> End Sub
>
> Any help would be greatly appreciated.
>


--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html

Hi Debra,

All I need for my "Database" is one column, which are student names--I
was planning on using these for my data validation listboxes. When I
set Database = to

=OFFSET(Students!$A$1,0,0,COUNTA(Students!$A:$A),256)

I got run-time error -2147417848 Method "AdvancedFilter' of object
'Range' failed. This was the code highlighted:

wsO.Range("Database").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=WsC.Range("J1:K2"), _
CopyToRange:=wsNL.Range("A1"), unique:=True

I have a dummy column set up in the last column for other purposes.

What are the criteria in J1:K2? If those are grades, then the Database
range should include a Grades column for filtering.

Arnold wrote:
> Hi Debra,
>
> All I need for my "Database" is one column, which are student names--I
> was planning on using these for my data validation listboxes. When I
> set Database = to
>
> =OFFSET(Students!$A$1,0,0,COUNTA(Students!$A:$A),256)
>
> I got run-time error -2147417848 Method "AdvancedFilter' of object
> 'Range' failed. This was the code highlighted:
>
> wsO.Range("Database").AdvancedFilter _
> Action:=xlFilterCopy, CriteriaRange:=WsC.Range("J1:K2"), _
> CopyToRange:=wsNL.Range("A1"), unique:=True
>
> I have a dummy column set up in the last column for other purposes.
>


--
Debra Dalgleish
Contextures
http://www.contextures.com/tiptech.html