What about this code is making Excel freeze when I try to switch to Page break preview after running it??
Rich (BB code):
Sub PD296Sara()
'
' PD296Sara Macro
'
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Initial Setup
Workbooks.OpenText Filename:= _
"\\Cisora12\it-windev_dscranton\pd296\1\PD296.prt", Origin:=437, StartRow:= _
1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(33, 1), Array(49 _
, 1), Array(65, 1), Array(80, 1), Array(93, 1)), TrailingMinusNumbers:=True
'Format Page
Columns("A:F").Select
Columns("A:F").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=3
Rows("1:25").Select
Range("A25").Activate
Selection.Delete Shift:=xlUp
Range("A3").Select
ActiveCell.FormulaR1C1 = "=RC[1]&RC[2]"
Range("A4").Select
ActiveCell.FormulaR1C1 = "=RC[1]&RC[2]"
Range("A4").Select
Selection.ClearContents
Range("D4").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],m/dd/yy)"
Range("D4").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""m/dd/yy"")"
Range("A4").Select
ActiveCell.FormulaR1C1 = "=RC[1]&RC[3]"
Range("A7").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(R[-1]C,"": "",R[-1]C[1],"" "",R[-1]C[2])"
Range("A7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A7").Cut Destination:=Range("A6")
Range("A7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C[4]&R[-1]C[5]"
Range("A1:A7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1:E7").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("F6").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = "Based on Report Run:"
Range("D1").Select
Selection.Cut Destination:=Range("E1")
Range("E1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = "at:"
Range("E2").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E1:F2").Select
Selection.Cut Destination:=Range("H1:I2")
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Range("E9").Select
ActiveCell.FormulaR1C1 = "Increase"
Range("F9").Select
ActiveCell.FormulaR1C1 = "Decrease"
Range("G8").Select
ActiveCell.FormulaR1C1 = "Revised"
Range("G9").Select
ActiveCell.FormulaR1C1 = "YTD"
Range("D10").Select
Selection.AutoFill Destination:=Range("D10:G10"), Type:=xlFillDefault
Range("D10:G10").Select
Range("H14").Select
Columns("B:B").EntireColumn.AutoFit
Columns("B:G").Select
Columns("B:G").EntireColumn.AutoFit
Range("H8").Select
Columns("B:B").ColumnWidth = 12
Columns("B:G").Select
Selection.ColumnWidth = 12
Range("H9").Select
ActiveCell.FormulaR1C1 = "Explanation"
Range("G10").Select
Selection.AutoFill Destination:=Range("G10:H10"), Type:=xlFillDefault
Range("G10:H10").Select
Columns("H:H").ColumnWidth = 17.57
Range("H13").Select
Columns("H:H").ColumnWidth = 26.71
Range("F1:G2").Select
Selection.Cut Destination:=Range("G1:H2")
Range("H4").Select
ActiveWindow.SmallScroll Down:=-12
'Scaffolding
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A1:A2").Select
Selection.AutoFill Destination:=Range("A1:A1054"), Type:=xlFillDefault
Range("b1054").Select
ActiveCell.FormulaR1C1 = "x"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Line"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Keep"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Desc"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Prior YTD"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Current Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Current YTD"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Increase"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Decrease"
Range("I1").Select
ActiveCell.FormulaR1C1 = "YTD"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Explanation"
Columns("C:D").Select
Selection.Insert Shift:=xlToRight
Range("D12").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],3)"
Range("C12").Select
ActiveCell.FormulaR1C1 = "1"
Range("e2000").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "x"
Range("c12:d12").Select
Selection.Copy
Range("C13:D13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("h2000").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
'Eliminate Superfluous Info
Columns("D:D").Select
Selection.Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range("b12").Select
ActiveCell.Formula = "=IF(OR(C12=401,AND(E10=""Sub-total"",D12=""475""),and(d12=""233"",f11=""----------------"")),""Delete"",IF(OR(AND(G12=""----------------"",E13=""Sub-total""),E11=""Margin Percent (Directs)"",E11=""Sub-total"",e11=""Total Directs"",E12=""Direct Labor"",E12=""Cost Per Directory"",E12=""Cost Per Stop"",E12=""Sub-total"",E12=""Distribution"",E12=""DIRECT OPER. COST"",E12=""Allocated Costs"",E12=""PR Load"",E12=""Total Directs"",E12=""Revenue"",E12=""Gross Margin"",E12=""Margin Percent (Sales)"",E12=""Margin Percent (Directs)"",E12=""Directories"",E12=""Stops"",E12=""Ops Statistics"",AND(ISNUMBER(C12),C12>1)),"""",""Delete""))"
ActiveCell.Copy
Range("b13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("A1:L1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="Delete"
Rows("13:13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=2
Range("b12").Select
ActiveCell.Formula = "=IF(D12=""0"","""",IF(C12>1,PROPER(E12),E12))"
Range("B12").Copy
Range("B13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("B12").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("E12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Determine Nature of Rows (Box or Total)
Range("I13").Select
ActiveCell.Formula = "=IF(AND($E13=""Gross Margin"", ISBLANK(F13)),"""",IF(OR($E13=""Sub-total"",$E13=""Total Directs"",$E13=""Cost Per Directory"",$E13=""Cost Per Stop"",$E13=""Gross Margin"",LEFT($E13,6)=""Margin""),""Total"",IF($F13=""----------------"",""----------------"",if($F13=""****************"",""****************"",IF($C13>1,""Box"","""")))))"
ActiveCell.Copy
Range("J13").Select
ActiveSheet.Paste
Range("I13:J13").Copy
Range("I14:J14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
'Place Red Boxes
Range("I13:J13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""box"""
With Selection.FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With Selection.FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With Selection.FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With Selection.FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
'YTD Totals
Range("K13").Select
ActiveCell.Formula = "=IF(ISBLANK(H13),"""",IF($H13=""---------------"",""---------------"",if($F13=""****************"",""****************"",H13+I13-J13)))"
ActiveCell.Copy
Range("K14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
'Create Sumif Data
Range("N12").Select
ActiveCell.Formula = "1"
Range("N13").Select
ActiveCell.Formula = "=IF(E13=""Total Directs"",N12+1,N12)"
Selection.Copy
Range("N14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("O12").Select
ActiveCell.Formula = "=if(or($E12=""Sub-Total"",Left(e12,3)=""475""),""Sum"","""")"
Selection.Copy
Range("O13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Columns("O:O").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P12").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",CONCATENATE(RC[-1],RC[-2]))"
Range("P12").Select
Selection.Copy
Range("P13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
'Create Scaffolding for Autosums
Range("Q12").Select
ActiveCell.Formula = "1"
Range("Q13").Select
ActiveCell.Formula = "=IF(H13=""---------------"",Q12+1,Q12)"
Selection.Copy
Range("Q14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("R12").Select
ActiveCell.Formula = "=IF($O12=""Sum"","""",IF(AND($O12="""",ISNUMBER($H12)),CONCATENATE(""Total"",$Q12),""""))"
Selection.Copy
Range("R13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
