Printe Autofilter Criterias in a Loop

[Paul.]

Hi every one,

I have a code given to me by Dave Paterson, (Thanksto him, it works
perfectly), which allows me to loop trhough the all list of one of my
criterias on an autofilter. The macro first sets a first criteria to non
blank in the field 16 and then loop through all myRg which is created on a
temporary worksheets by copying the all list of datas in the column of the
field 4. This list ist then filtered to give a list of unique entries. This
list is myRg.
Prior to print for each criteria i.e each entry of myRg I would like the
Macro to display on top of my header Row "Next Week' in cell N1 and the
criteria in Cell O1.
The Code is as follow:

Option Explicit
Sub Print_Next_Weeek_Task_Lists()
Application.ScreenUpdating = False
Dim newWks As Worksheet
Dim curWks As Worksheet
Dim myRng As Range
Dim myUniqueRng As Range
Dim myCell As Range

Set curWks = Sheets("Critical Path")
Set newWks = Worksheets.Add

With curWks
.AutoFilterMode = False
Set myRng = .Range("A4", .Cells.SpecialCells(xlCellTypeLastCell))
myRng.AutoFilter Field:=16, Criteria1:="<>"
myRng.Columns(4).Copy _
Destination:=newWks.Range("a4")
With newWks
.Range("a4", .Cells(.Rows.Count, "a")).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("b4"), Unique:=True
.Range("b:b").Sort Key1:=Range("b4"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Set myUniqueRng = .Range("b5", .Cells(.Rows.Count, "b").End(xlUp))
End With

For Each myCell In myUniqueRng.Cells
myRng.AutoFilter Field:=4, Criteria1:=myCell.Value
.PrintOut Copies:=1, preview:=False
Next myCell

If someone cold help me it would be great

Regards,

Paul

 

[Dave Peterson]

For Each myCell In myUniqueRng.Cells
myRng.AutoFilter Field:=4, Criteria1:=myCell.Value
.PrintOut Copies:=1, preview:=False
Next myCell

could change to:

.range("N1").value = "Next Week" 'just do this once
For Each myCell In myUniqueRng.Cells
myRng.AutoFilter Field:=4, Criteria1:=myCell.Value
.range("O1").value = mycell.value
.PrintOut Copies:=1, preview:=False
Next myCell

'clean things up
.range("N1").clearcontents
.range("o1").clearcontents

===
If that value that goes into o1 should be formatted special, you can put:

.range("N1").value = "Next Week" 'just do this once
For Each myCell In myUniqueRng.Cells
myRng.AutoFilter Field:=4, Criteria1:=myCell.Value
with .range("O1")
.value = mycell.value
.numberformat = "0000"
end with
.PrintOut Copies:=1, preview:=False
Next myCell

'clean things up
.range("N1").clearcontents
.range("o1").clearcontents


====