• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Automatic filter and print

marreco

Member
how to reduce this code?
Code:
Sub FilterAndPrint()
   
    Dim ws As Worksheet
    Dim lastrow As Long
   
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
        With ws
            lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="INTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="INTERNO 1"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="INTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="INTERNO 2"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="INTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="INTERNO 3"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="EXTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="EXTERNO 1"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="EXTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="EXTERNO 2"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="EXTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="EXTERNO 3"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
        End With
    Application.ScreenUpdating = True
   
End Sub
 
No sample file ... couldn't test so well.
Code:
Sub FilterAndPrint()
   
    Dim ws As Worksheet
    Dim lastrow As Long
   
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
        With ws
            lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
           
            For ie = 1 To 2
                crit1 = "INTERNO"
                If ie = 2 Then crit1 = "EXTERNO"
                For ei = 1 To 3
            'Filter and print again
                    .AutoFilterMode = False
                    .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:=crit1
                    .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:=crit1 & " " & ei
                    .PageSetup.PrintArea = ""
                    .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
                Next ei
            Next ie
           
        End With
    Application.ScreenUpdating = True
   
End Sub
 
Back
Top