Hello,

I have a list with an autolfilter. I would like to know what I need to add
to the following code in order for the macro to print-out a list for every
different criterias in the field 4.
I want the macro to run only for the criterias ( profesional position like
"A.D.O.S.M.") available in the field 4 autofilter dropdown box. The list of
criterias available in this dropdown box changes every week due to the first
autofilter selection (Field 16).

Any help would be much appreciated.

Thank you

Sub test1
'
'test1 Macro
'Macro recorded 24/03/2005 by PAUL
'
Selection.AutoFilter Field:=16, Criteria1:="<"
Selection.Autofilter Field:=4, Criteria1:="A.D.0.S.M."
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

I personally don't like to work with selections. If it's possible, I'll define
the range.

So in this example, I used A1 (headers in row 1) through the last used cell
(ctrl-end to find it manually).

Option Explicit
Sub test1()

Dim newWks As Worksheet
Dim curWks As Worksheet
Dim myRng As Range
Dim myUniqueRng As Range
Dim myCell As Range

Set curWks = ActiveSheet
Set newWks = Worksheets.Add

With curWks
.AutoFilterMode = False
Set myRng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
myRng.AutoFilter Field:=16, Criteria1:="<"
myRng.Columns(4).Copy _
Destination:=newWks.Range("a1")
With newWks
.Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True
.Range("b:b").Sort Key1:=Range("b1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Set myUniqueRng = .Range("b2", .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:=True
Next myCell

If .FilterMode Then
.ShowAllData
End If

End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True

End Sub

This code creates a new temporary worksheet,
then filters the original sheet by column 16 (P).
Then copies column 4 to that new sheet.
It does an data|Filter|advanced filter to get a list of unique values and puts
it in column B.
Then it sorts column B and filters on all those values in column b.
Finally, it cleans up after itself--removes the current filter criteria and
deletes that temporary worksheet.

I used preview:=true for testing. delete this portion when you're done testing.

Paul. wrote:

Hello,

I have a list with an autolfilter. I would like to know what I need to add
to the following code in order for the macro to print-out a list for every
different criterias in the field 4.
I want the macro to run only for the criterias ( profesional position like
"A.D.O.S.M.") available in the field 4 autofilter dropdown box. The list of
criterias available in this dropdown box changes every week due to the first
autofilter selection (Field 16).

Any help would be much appreciated.

Thank you

Sub test1
'
'test1 Macro
'Macro recorded 24/03/2005 by PAUL
'
Selection.AutoFilter Field:=16, Criteria1:="<"
Selection.Autofilter Field:=4, Criteria1:="A.D.0.S.M."
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

--

Dave Peterson

Dear Dave,

Thanks a lot, it works perfectly.

Cheers

Paul

"Dave Peterson" wrote:

I personally don't like to work with selections. If it's possible, I'll define
the range.

So in this example, I used A1 (headers in row 1) through the last used cell
(ctrl-end to find it manually).

Option Explicit
Sub test1()

Dim newWks As Worksheet
Dim curWks As Worksheet
Dim myRng As Range
Dim myUniqueRng As Range
Dim myCell As Range

Set curWks = ActiveSheet
Set newWks = Worksheets.Add

With curWks
.AutoFilterMode = False
Set myRng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
myRng.AutoFilter Field:=16, Criteria1:="<"
myRng.Columns(4).Copy _
Destination:=newWks.Range("a1")
With newWks
.Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True
.Range("b:b").Sort Key1:=Range("b1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Set myUniqueRng = .Range("b2", .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:=True
Next myCell

If .FilterMode Then
.ShowAllData
End If

End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True

End Sub

This code creates a new temporary worksheet,
then filters the original sheet by column 16 (P).
Then copies column 4 to that new sheet.
It does an data|Filter|advanced filter to get a list of unique values and puts
it in column B.
Then it sorts column B and filters on all those values in column b.
Finally, it cleans up after itself--removes the current filter criteria and
deletes that temporary worksheet.

I used preview:=true for testing. delete this portion when you're done testing.

Paul. wrote:

Hello,

I have a list with an autolfilter. I would like to know what I need to add
to the following code in order for the macro to print-out a list for every
different criterias in the field 4.
I want the macro to run only for the criterias ( profesional position like
"A.D.O.S.M.") available in the field 4 autofilter dropdown box. The list of
criterias available in this dropdown box changes every week due to the first
autofilter selection (Field 16).

Any help would be much appreciated.

Thank you

Sub test1
'
'test1 Macro
'Macro recorded 24/03/2005 by PAUL
'
Selection.AutoFilter Field:=16, Criteria1:="<"
Selection.Autofilter Field:=4, Criteria1:="A.D.0.S.M."
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

--

Dave Peterson