Couldn't get the code to populate in the original post. Here it is:
Sub StateProvisionFormat()
Dim TotalCell As Range
'Format the title rows at the top. Unmerge the cells at the top in case the file was ran as a single report in OTP
Range("B1:AE6").ClearContents
Range("A1:A4").WrapText = False
If SignoffOption = vbYes Then
Range("A5").Value = "Prepared By:"
Range("A6").Value = "Reviewed By:"
With Range("A5:A6")
.HorizontalAlignment = xlRight
.Font.Size = 10
.Font.Name = "Arial"
.Font.Bold = False
End With
Else
'Do Nothing
End If
'Autofit columns based on contents under header
Range("C8").Select
Do Until ActiveCell = "" It Crashes during this loop
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Columns.AutoFit
If Columns(ActiveCell.Column).ColumnWidth < 15.71 Then
Columns(ActiveCell.Column).ColumnWidth = 15.71
End If
ActiveCell.Offset(-1, 1).Select
Loop
'Set Height of Row 7
Rows(8).RowHeight = 26.25
Columns(1).ColumnWidth = 45
'Add freeze panes to consolidated and sub consolidated reports
If Left(Range("A3"), 12) = "Consolidated" Or Left(Range("A3"), 15) = "SubConsolidated" Then
'Check to see if search term (Total) exist in the file
Set TotalCell = Columns(2).Find("TOTAL")
If TotalCell Is Nothing Then 'when TOTAL is not listed in the second column, proceed without crashing code
GoTo EndFrezePane
Else
Application.Goto Range("A1"), True
TotalCell.Activate
ActiveCell.Offset(1, 1).Select
ActiveWindow.FreezePanes = True
End If
End If
EndFrezePane:
'Set Print Area to print to one page wide
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$8"
.Zoom = False
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
.FitToPagesWide = False
.FitToPagesTall = 1
.LeftFooter = "&Z&F"
.RightHeader = "&D &T"
End With
End Sub
Bookmarks