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
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