Loop Macro autofilter
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 |
All times are GMT +1. The time now is 10:19 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com