using named ranges and copy with Advanced Filter

  • Thread starter Thread starter Marcia
  • Start date Start date
M

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("C4:D195").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
 
You can count the rows on the new sheet, and paste at the first blank
row. The following code should give you some ideas for adjusting your code:

'=================================================
Sub FilterToNewSheet()
Dim wsCL As Worksheet
Dim wsF As Worksheet
Dim r As Long
Set wsCL = Sheets("Complete List")

Set wsF = Sheets.Add
wsF.Name = "filtered"
wsCL.Range("C4:D195").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsCL.Range("N1:N2"), _
CopyToRange:=Range("B1"), Unique:=False

'find first blank row on wsF
r = Cells(wsF.Rows.Count, 2).End(xlUp).Row + 1
wsCL.Range("H4:I195").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsCL.Range("N1:N2"), _
CopyToRange:=wsF.Cells(r, 2), Unique:=False
wsF.Rows(r).EntireRow.Delete

r = Cells(wsF.Rows.Count, 2).End(xlUp).Row + 1
wsCL.Range("M4:O195").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsCL.Range("N1:N2"), _
CopyToRange:=wsF.Cells(r, 2), Unique:=False
wsF.Rows(r).EntireRow.Delete

r = Cells(wsF.Rows.Count, 2).End(xlUp).Row + 1
wsCL.Range("S4:U195").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsCL.Range("N1:N2"), _
CopyToRange:=wsF.Cells(r, 2), Unique:=False
wsF.Rows(r).EntireRow.Delete

r = Cells(wsF.Rows.Count, 2).End(xlUp).Row + 1
wsCL.Range("Y4:AA195").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsCL.Range("N1:N2"), _
CopyToRange:=wsF.Cells(r, 2), Unique:=False
wsF.Rows(r).EntireRow.Delete

With wsF.Cells
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
.EntireRow.AutoFit
.EntireColumn.AutoFit
End With
wsF.Columns("C:C").EntireColumn.Hidden = True
wsF.Range("A1").Select
End Sub
'=========================================
 
Thanks Debra! But I do have a question about one of the lines of code.

wsF.Rows(r).EntireRow.Delete

Why does it need to delete a row?

Thanks,
Marcia
 
When you use an Advanced Filter, the headings are included. You can
leave them in if you want, but my code assumes you want to remove them,
except for the first instance.
 
Thanks for the explanation. I'm not very good with VBA code which is why I
recorded the macro to begin with. :-)

Thanks again,
Marcia
 
Back
Top