page format in VBA

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
I copied the macro recorder to try to set up formatting and borders, but I can not get it to run correctly. Please see the Sub FormatReport1 and Sub PageSetupReport1. Is there a better way to manage these procedures within the loop?

Mike

Code:
Set outsh = Worksheets("FilterCriteria")
For Each ce In outsh.Range("BN3", "BN58")
For i = 1 To 10
    ToRow = Worksheets("Report1").Range("A65536").End(xlUp).Row + 1
    LastRow = Range("A65536").End(xlUp).Row
    With Worksheets("Data" & i)
        
        On Error Resume Next
        
         
        .Range("AO1").Value = "Resource"            'Criteria Range copied into Data sheets
        .Range("AO2").Value = ce.Value
        .Range("AP1").Value = "Date"
        .Range("AQ1").Value = "Date"
        .Range("AP2").Value = Worksheets("FilterCriteria").Cells(3, 3)
        .Range("AQ2").Value = Worksheets("FilterCriteria").Cells(3, 4)
        .Range("A4:AN" & 30000).AdvancedFilter Action:=xlFilterInPlace, criteriarange:=.Range("AO1:AQ2") ', copytorange:=outsh.Cells(Rows.Count, ce.Column).End(xlUp).Offset(1, 0)
        .Range("AO1:AQ2").ClearContents
  End With
    
    Next i
    Copy_Rng                        'Procedure below
    Sort_Report1                    'Procedure below
    FormatReport                    'Procedure below
    Report1PageSetUp                'Procedure below
    Worksheets("Report1").PrintOut Copies:=1, Collate:=True
    Clear_Report1
    Next ce
  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
    .Calculation = xlCalculationManual
    End With
  End Sub

'--------------------------------------------------------------------------
Sub FormatReport()
    LastRow = Cells(65536, 1).End(xlUp).Row
    LastCol = Cells(1, 255).End(xlToLeft).Column
    With Worksheets("Report1").Range("A1").EntireRow          'Format Headers
        .Font.Bold = True
        .HorizontalAlignment = xlLeft
        .WrapText = True
    End With

With Worksheets("Report1")                                    'Set Column widths
    .Range("A1").ColumnWidth = 5
    .Range("B1").ColumnWidth = 5
    .Range("C1").ColumnWidth = 5
    .Range("D1").ColumnWidth = 10
    .Range("E1").ColumnWidth = 20
    .Range("F1").ColumnWidth = 30
    .Range("G1").ColumnWidth = 20
    .Range("H1").ColumnWidth = 5
  
    .Range("G2:G" & LastRow).NumberFormat = "[$-409]ddd, d-mmm"         'Format Date
End With
Worksheets("Report1").Range(Cells(1, 1), Cells(LastRow, LastCol)).Select  'Format Borders and alignment
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
     End With

Worksheets("Report1").Range(Cells(1, 1), Cells(LastRow, LastCol)).Select
     With Selection.Borders(xlEdgeLeft)                                     'Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        '.LineStyle = xlContinuous
        '.Weight = xlThin
        '.ColorIndex = Automatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        '.LineStyle = xlContinuous
        '.Weight = xlThin
        '.ColorIndex = xlAutomatic
    End With
    
      
End Sub
'-----------------------------------------------------------------------------------------------------------------
'Routine-Set Print Page Set up
'-------------------------------------------------------------------------------------------------------------------
 Sub Report1PageSetUp()
 With Worksheets("Report" & i)
        LastRow = Range("A65536").End(xlUp).Row
        LastCol = Range("IV4").End(xlToLeft).Column
        Worksheets("Report1").PageSetup.PrintArea = Range(Cells(1, 1), Cells(LastRow, 8)).Address
    
    With Worksheets("Report" & i).PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .LeftHeader = "&D"
        .CenterHeader = "Botanica Lakes" & Chr(10) & "Subcontractor Schedule"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "Page &P of &N"
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.25)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLegal
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 90
        .PrintErrors = xlPrintErrorsDisplayed
    End With
End With

   
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,247
Hi Mike,
may I suggest that you explain wich part of your code does not behave according to your expectations, or (from another point of view) wich actions you would expect that the macros don't execute.

Also, you wrote "see the Sub FormatReport1 and Sub PageSetupReport1": I assume that you mean FormatReport and Report1PageSetUp, right?

Bye,
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
Anthony,

Sorry I was vague. You are correct. I was referring to Sub FormatReport1 and Sub PageSetupReport1.

In the Sub FormatReport1, I can not seem to get the borders to format correctly. On the first loop, it prints the outside border lines around the range correctly, but does not print the interior vertical or horizontal lines.

After the first loop, it prints the outside borders on the top edge, right and left, but not the bottom line, and as in the first loop does not print the interior vertical and horizontal lines.

Any ideas?
Mike
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
Anthony,

It's printing fine right now. Thanks.
Mike
 

mt

Board Regular
Joined
Feb 24, 2006
Messages
134
Anthony,

Okay, I may be a little nuts here. I just ran the entire macro and it prints the first 9 items of the CE loop fine (this time) and then reverts back to no borders and it skips printing and formatting the header row after the 9th item, and does not sort.

It's not just the print borders. When I was testing it with just two items in the CE loop (filter criteria), it worked except for the borders.
 

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,247
I should suggest that you remove the On Error Resume Next, so that in case of error you can enter and debug the code (now, in case of error it just continues as it were perfect; very bad!).
You can then debug the macros using F8 to execute step by step the code and examine the results, or F9 to set a breakpoint at that instruction; you can even read the content of variables or instructions by moving the cursor over that variable name or instruction (no click). In the tool bar you will find the "Continue" button (or F5) and the Stop button.

Debugging is a very nice part of the job...

Let us know.
 

Forum statistics

Threads
1,141,844
Messages
5,708,928
Members
421,599
Latest member
santosh234

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top