**Print Area Macro OR alternative solution! :)

[pleasehelpSP]

Hi all,

I have 2-ish problems. First, I want to create a format that shades every other line grey in my worksheet - however, Excel won't let me do that because I am using AutoFilters. It says they must be disabled in order to format what I have, but I cant afford to undo them.

So, I thought I would manually (ugh, I know) shade every other row grey up to about a gazillion because I really need the every other line distinction. BUT, when I go to print, it prints ALL of the rows I've shaded grey (ie 50,000 pgs) so I attempted to make a Macro to select the print area of only the cells that have text.

I was given (bc I am code illiterate):

ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Address

Which does set the print area, but still to the last cell formatted.

Can someone help me set the print area to the last row with TEXT or better yet, fix my inital problem??

-SP

 

[AlphaFrog]

Try something like this to set the print area to the last row with TEXT...

ActiveSheet.PageSetup.PrintArea = Range("A1", Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)).Address

I don't fully appreciate the first part of your problem? Are you wanting to shade every other row of the Visible filtered cells? So the if rows 1,3,5,7,9 were visible and the even rows were not, you want to shade rows 1,5,9 ?

 

[Datsmart]

You can use Conditional Formatting to set Row Color that adjusts with AutoFiltered Rows:

Select the range of the cells you want colored.
On the Home Ribbon, click "Conditional Format" in the :: section.
Click "New Rule"
Click "Use a formula to determine which cells to format.
Put this formula in the formula field.
'=EVEN((SUBTOTAL(3,A$1:A1)))=SUBTOTAL(3,A$1:A1)
Click the "Format..." button.
Choose the color formatting you want.
Click OK.

 

[pleasehelpSP]

Try something like this to set the print area to the last row with TEXT...

ActiveSheet.PageSetup.PrintArea = Range("A1", Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)).Address

Hey AlphaFrog,

This ALMOST works! It finds the last row with text, but it is cutting off my last column - column M. Column M will always be the last column in the print area, but the row is the variable. Anyway you can add that in??

-SP

 

[AlphaFrog]

Try this...

ActiveSheet.PageSetup.PrintArea = "A1:M" & Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 

[pleasehelpSP]

Try this...

ActiveSheet.PageSetup.PrintArea = "A1:M" & Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Thank you SOOOOOOO much! Works like a charm. This has been a big help, I really appreciate it! : )

-SP

 

[malvdh]

Hello pros, (excel 2007, windows xp)

Well I have been looking for this type of solution and it works as is, but I need it to start with cell "C2" through column "N".

Try this...

ActiveSheet.PageSetup.PrintArea = "A1:M" & Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

How can I change this code to work? I have already tried changing "A1:M" to "C2:N" Which only brings up a runtime error '1004': Application-defined or object error in my pagebreak subroutine.

I will post more of my code if needed.
-malvdh

 

[AlphaFrog]

I have already tried changing "A1:M" to "C2:N" Which only brings up a runtime error '1004': Application-defined or object error in my pagebreak subroutine.

I will post more of my code if needed.

Changing "A1:M" to "C2:N" should work in theory. Cells.Find... looks for the last used row on the active sheet. Is the ActiveSheet the same sheet you are looking to set the print area on?

Can you post your code?

 

[malvdh]

Greetings AlphaFrog,

The code below is only parts of a bigger program that pulls apart the different sections of the monthly report, which is thousands of rows long. Most of my code for that part came from this site, and works great, except the print area and page breaking. Before switching to excel 2007 from 2003 I had no problem with the print area and page breaks as I would fix the main report before splitting it out and the print area and page breaks would carry over to the separated sections.

All my code is in it's own workbook with a button that activates the process. (ie: Opening the monthly report which becomes the active sheet.)

When changing that piece of code I get the runtime error.
Highlighted line for runtime error is:

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell

Test code:

Option Explicit

Sub mReportOpen()
'User must find MonthlyReport.xlsx
Dim fileToOpen As Variant

fileToOpen = Application _
    .GetOpenFilename("Text Files (*.*), *.*")
If fileToOpen <> False Then
    Workbooks.OpenText Filename:=fileToOpen
'    MsgBox "Open " & fileToOpen
End If

Call mReportSetup
End Sub

Sub SaveWk()
'Save
    ActiveWorkbook.Save
End Sub

Sub CloseWk()
'Close
    ActiveWorkbook.Close
End Sub

Sub mReportSetup()

    Rows("1:1").Select
    Selection.AutoFilter
    Columns("C:C").Select
    Selection.ColumnWidth = 50
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 70
        .PrintErrors = xlPrintErrorsDisplayed
    End With

ActiveSheet.PageSetup.PrintArea = "C2:N" & Cells.Find("*", SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row

    Call mReportPBreak

End Sub

Sub mReportPBreak()

Dim myStr1 As String
Dim c1 As Range
Dim firstAddress As Variant
Dim Answer1 As Integer

myStr1 = "TopOfPage"

With ActiveSheet.Range("C:C")
 Set c1 = .Find(myStr1, LookIn:=xlValues)
 If Not c1 Is Nothing Then
    firstAddress = c1.Address
    Do
        Cells.FindNext(After:=ActiveCell).Activate
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
        Set c1 = .FindNext(c1)
        
        On Error GoTo ErrHand1
        
    Loop While Not c1 Is Nothing And c1.Address <> firstAddress
        
 End If
 
End With

ErrHand1:
    Answer1 = MsgBox("Setup Complete!", _
    vbOKCancel + vbQuestion, "Monthly Report")
        If Answer1 = vbCancel Then
        Call CloseWk
            Exit Sub
            Else
                Range("A1").Select
                ActiveWindow.SmallScroll ToRight:=0
                Call SaveWk
                Call CloseWk
        End If
 
End Sub

The below screenshot is just a sample of the monthly report. The issues with it are:
-Report to print has blank rows
-Report changes in length each month, but not width
-Report is all one column and cannot be edited without losing formatting
-I manually adjust the numbers along the side each month (Another issues I'd like to work on later)
note: To to the information contained in this monthly report I can not edit the report to fit multiple columns.

The numbers along the side represent the fund and center numbers for the monthly report. These are not real numbers just something to show what I have to get done.

fund 22222
center 1000
center 1010
fund 33333
center 1000
fund 44444
center 1000
center 1001
fund 55555
center 1000
center 90000

Sorry I haven't been able to get the spreadsheet maker working, wish I could just attach the sample file I have.

Please let me know if you need any more explanation.
Thanks for any help you can provide.
-malvdh

 

[AlphaFrog]

Try this...

    On Error GoTo ErrHand1
    With ActiveSheet.Range("C:C")
        Set c1 = .Find(myStr1, LookIn:=xlValues, LookAt:=xlPart)
        If Not c1 Is Nothing Then
            firstAddress = c1.Address
            Set c1 = .FindNext(c1)
            Do While c1.Address <> firstAddress

                ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=c1
                Set c1 = .FindNext(c1)

            Loop

        End If

    End With