using named ranges and copy with Advanced Filter

[Marcia]

I'm working with a spreadsheet (called Complete List in my example below)
and am trying to copy my filtered results to a new sheet (called filtered in
my example below). I set up a Criteria range of N1:N2 so the user could
enter a criteria in cell N2 and I could utilize the Advanced Filter. I was
able to record a macro and carry out each step as you can see below.
However, I'd like to now make some modifications to improve it.

First, I did name the ranges I wanted to use for each of the sets of
filters. However, as I was recording the macro, it wouldn't let me click to
choose my named range. Does anyone know if I can change this code to use my
named ranges instead?

As I ran the filter, I wanted the data to copy to the next blank row. I
used the keyboard shortcut End+Home, then arrowed down to next row and used
Home key to get to first cell of that row. It appears from my code
(indicated with the lines starting Range("XXX").Select) that a particular
cell was chosen instead. Depending on the criteria being filtered, I will
have different number of rows each time so may not always end on cell A11,
or A28, etc. Is there a better way to specify the next blank cell?

Sorry if this post is lengthy but I always hope by giving as much
information as possible, it will assist anyone kind enough to try to help
me.

Thanks,
Marcia
****************************************************************************
****************
Sub filter()
'
' filter Macro
' Macro recorded 5/11/2004 by Marcia Wabeke
'
'
Sheets("Complete List").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "filtered"
Range("A1").Select
Sheets("Complete List").Range("C4195").AdvancedFilter
Action:=xlFilterCopy _
, CriteriaRange:=Sheets("Complete List").Range("N1:N2"),
CopyToRange:=Range _
("B1"), Unique:=False
ActiveCell.SpecialCells(xlLastCell).Select
Range("A11").Select
Sheets("Complete List").Range("H4:I195").AdvancedFilter
Action:=xlFilterCopy _
, CriteriaRange:=Sheets("Complete List").Range("N1:N2"),
CopyToRange:=Range _
("B11"), Unique:=False
ActiveCell.SpecialCells(xlLastCell).Select
Range("A28").Select
Sheets("Complete List").Range("M4:O195").AdvancedFilter
Action:=xlFilterCopy _
, CriteriaRange:=Sheets("Complete List").Range("N1:N2"),
CopyToRange:=Range _
("A28"), Unique:=False
ActiveCell.SpecialCells(xlLastCell).Select
Range("A60").Select
Sheets("Complete List").Range("S4:U195").AdvancedFilter
Action:=xlFilterCopy _
, CriteriaRange:=Sheets("Complete List").Range("N1:N2"),
CopyToRange:=Range _
("A60"), Unique:=False
ActiveCell.SpecialCells(xlLastCell).Select
Range("A206").Select
Sheets("Complete List").Range("Y4:AA195").AdvancedFilter
Action:=xlFilterCopy _
, CriteriaRange:=Sheets("Complete List").Range("N1:N2"),
CopyToRange:=Range _
("A206"), Unique:=False
Cells.Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
End Sub

 

[Dave Peterson]

I think I'd just do the filter multiple times.

Here's code that uses the first column of each group to determine the last row
of that group. It uses column B of the "filter" worksheet to figure out the
next row.

Option Explicit
Sub filter()

Dim CompWks As Worksheet
Dim FiltWks As Worksheet
Dim FiltRng As Range
Dim CritRng As Range
Dim DestCell As Range

Set CompWks = Worksheets("complete list")

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("filtered").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set FiltWks = Worksheets.Add
FiltWks.Name = "Filtered"

With CompWks

Set CritRng = .Range("n1:n2")

Set DestCell = FiltWks.Range("b1") 'starting point.
Set FiltRng = .Range("C4" & .Cells(.Rows.Count, "C").End(xlUp).Row)
FiltRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CritRng, _
CopyToRange:=DestCell, Unique:=False


With FiltWks
Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
End With
Set FiltRng = .Range("H4:I" & .Cells(.Rows.Count, "H").End(xlUp).Row)
FiltRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CritRng, _
CopyToRange:=DestCell, Unique:=False


With FiltWks
Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, -1)
End With
Set FiltRng = .Range("M4:O" & .Cells(.Rows.Count, "M").End(xlUp).Row)
FiltRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CritRng, _
CopyToRange:=DestCell, Unique:=False


With FiltWks
Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, -1)
End With
Set FiltRng = .Range("s4:U" & .Cells(.Rows.Count, "S").End(xlUp).Row)
FiltRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CritRng, _
CopyToRange:=DestCell, Unique:=False


With FiltWks
Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, -1)
End With
Set FiltRng = .Range("Y4:AA" & .Cells(.Rows.Count, "Y").End(xlUp).Row)
FiltRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CritRng, _
CopyToRange:=DestCell, Unique:=False

End With

With FiltWks.UsedRange
.Columns.AutoFit
.Rows.AutoFit
.Range("c:c").EntireColumn.Hidden = True
End With

End Sub

Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
says to drop down one row from the last used cell in column B.

Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, -1)
says to dropdown one row and go back one column (to get to column A).

 

[Marcia]

Thanks, this is great and even answered another question I was dealing with.
Each time I ran my original macro, I had to click OK for the prompt to
delete the sheet. Since I am trying to develop this for someone else to
use, it's great that person won't have to deal with clicking OK on the
prompt.

Much thanks,
Marcia