PrintArea = "TableName" but visible cells only

[willow1985]

I have this code that adjusts the print area based on the report the person is wanting to print, but lately it is printing double the pages. For example if the report happens to be 7 pages, it will have 7 pages plus an additional 7 that are blank when I look at print preview.

I am wondering if this is because of the columns that are hidden in the macro.

I am not sure 100% this is the problem but figured it was a good start

So my question is: Is there a way to set the PrintArea for a table for visible cells only?
See below code and thank you to anyone who can help!

Sub Hearing_Testing()
'
' Hearing_Testing Macro
'

    Columns("A:A").EntireColumn.Hidden = True
    Columns("D:F").EntireColumn.Hidden = True
    Columns("H:H").EntireColumn.Hidden = True
    Columns("K:P").EntireColumn.Hidden = True
With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = "Emp_Listing[#All]" 'wondering if this line is my issue, printing the whole table even the hidden columns?? Change to visible only?
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$2"
        .PrintTitleColumns = ""
    End With
            With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.354330708661417)
        .RightMargin = Application.InchesToPoints(0.354330708661417)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 120
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
End Sub

 

[DanteAmor]

Check the following:

-----------------​

In the code you have the zoom property at 120, perhaps that is causing the sheet on the right side to overflow and that implies the printing of more sheets.
Try 100

        .Zoom = 120

---------------​

Also try the following, replace this line:

        .Zoom = 120

For these:

        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 7                 '

I put the number 7 only to do the test, we must rule out the possible problems.

---------------------------​

Other option:

Replace this line:

ActiveSheet.PageSetup.PrintArea = "Emp_Listing[#All]"

By these lines:

  Dim lr As Long, lc As Long
  lr = ActiveSheet.ListObjects("Emp_Listing").Range.Rows.Count
  lc = ActiveSheet.ListObjects("Emp_Listing").Range.Columns.Count
  lr = Range("A1", Cells(Rows.Count, lc)).Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  ActiveSheet.PageSetup.PrintArea = Range("A1", Cells(lr, lc)).Address

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

​

 

[willow1985]

Check the following:

View attachment 95421

-----------------​

In the code you have the zoom property at 120, perhaps that is causing the sheet on the right side to overflow and that implies the printing of more sheets.
Try 100

        .Zoom = 120

---------------​

Also try the following, replace this line:

        .Zoom = 120

For these:

        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 7                 '

I put the number 7 only to do the test, we must rule out the possible problems.

---------------------------​

Other option:

Replace this line:

ActiveSheet.PageSetup.PrintArea = "Emp_Listing[#All]"

By these lines:

  Dim lr As Long, lc As Long
  lr = ActiveSheet.ListObjects("Emp_Listing").Range.Rows.Count
  lc = ActiveSheet.ListObjects("Emp_Listing").Range.Columns.Count
  lr = Range("A1", Cells(Rows.Count, lc)).Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  ActiveSheet.PageSetup.PrintArea = Range("A1", Cells(lr, lc)).Address

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

​

This seems to have fixed the problem:

        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 7

Thank you very much