Sub PD296Detail1()
'
' PD296Detail1
' Macro recorded 5/10/2010 by Derek Scranton
'
'
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
'Delete Headers
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
Rows("1:1").Select
Selection.Insert Shift:=xlDown
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"
Range("B15").Select
ActiveCell.Formula = "=IF(OR(RIGHT(C5,5)=""PD296"",RIGHT(C6,5)=""PD296"",RIGHT(C7,5)=""PD296"",RIGHT(C8,5)=""PD296"",RIGHT(C9,5)=""PD296"",RIGHT(C10,5)=""PD296"",RIGHT(C11,5)=""PD296"",RIGHT(C12,5)=""PD296"",RIGHT(C13,5)=""PD296"",RIGHT(C14,5)=""PD296"",RIGHT(C15,5)=""PD296""),""Delete"","""")"
Selection.Copy
Range("B16").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:J1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="Delete"
With ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1, 20).SpecialCells(xlCellTypeVisible).Delete
End With
Selection.AutoFilter Field:=2
'Remove Superfluous Rows
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R[-1]C[1]=""Cost Per Stop"",R[-1]C=""Delete""),""Delete"","""")"
Range("B2").Select
Selection.Copy
Range("B3:B956").Select
ActiveSheet.Paste
Selection.AutoFilter Field:=2, Criteria1:="Delete"
With ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1, 20).SpecialCells(xlCellTypeVisible).Delete
End With
Selection.AutoFilter Field:=2
'Add x's
Range("c1000").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(0, 4).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"
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, 1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "x"
'Set Print Area
With ActiveSheet.PageSetup
.PrintTitleRows = "$9:$11"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.25)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.SmallScroll Down:=-78
ActiveWindow.SmallScroll Down:=-57
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
'Determine the nature of cells in increase and decrease columns
Range("G12").Select
ActiveCell.Formula = "=IF($C12=""Sub-total"",SUMIF($M:$M,""Sum""&KK11,G:G),IF(AND(ISTEXT($F11),ISBLANK($C11)),"""",IF(AND(ISBLANK($F10),ISTEXT($F11)),""Box"",IF(ISTEXT($F11),""Total"",IF(ISBLANK($F12),"""",IF(ISTEXT($F12),$F12,""Box""))))))"
Selection.Copy
Range("G13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("h12").Select
ActiveCell.Formula = "=IF($C12=""Sub-total"",SUMIF($M:$M,""Sum""&KK11,G:G),IF(AND(ISTEXT($F11),ISBLANK($C12)),"""",IF(AND(ISBLANK($F10),ISTEXT($F11)),""Box"",IF(ISTEXT($F11),""Total"",IF(ISBLANK($F12),"""",IF(ISTEXT($F12),$F12,""Box""))))))"
Selection.Copy
Range("h13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
'Create Sumif Data
Range("k12").Select
ActiveCell.Formula = "1"
Range("k13").Select
ActiveCell.Formula = "=IF(c13=""Sub-total"",PD296!K12+1,PD296!K12)"
Selection.Copy
Range("k14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("L12").Select
ActiveCell.Formula = "=if($h12=""Total"",""Sum"","""")"
Selection.Copy
Range("L13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Columns("L:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M12").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",CONCATENATE(RC[-1],RC[-2]))"
Range("M12").Select
Selection.Copy
Range("M13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-9
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToRight:=3
'Create Autosums
Range("N12").Select
ActiveCell.Formula = "1"
Range("N13").Select
ActiveCell.Formula = "=IF(F13=""---------------"",N12+1,N12)"
Selection.Copy
Range("N14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("O12").Select
ActiveCell.Formula = "=IF($L12=""Sum"","""",IF(AND($L12="""",ISNUMBER($F12)),CONCATENATE(""Total"",$N12),""""))"
Selection.Copy
Range("O13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
'YTD Formulas
Range("I12").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(OR(ISTEXT(RC[-1]),RC[-1]=""""),"""",RC[-3]+RC[-2]-RC[-1])"
Range("I12").Select
Selection.Copy
Range("I13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Columns("G:H").Select
Application.CutCopyMode = False
Selection.FormatConditions.Delete
'Place Red Boxes
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
'Revised YTD Totals
Range("I12").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(ISTEXT(RC[-3]),RC[-3],IF(RC[-3]="""","""",RC[-3]+RC[-2]-RC[-1]))"
Range("I12").Select
Selection.Copy
Range("I13").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("G13").Select
Application.CutCopyMode = False
Range("J12").Select
ActiveWindow.SmallScroll Down:=-6
Range("J13").Select
Application.FindFormat.Borders(xlDiagonalDown).LineStyle = xlNone
Application.FindFormat.Borders(xlDiagonalUp).LineStyle = xlNone
With Application.FindFormat.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With Application.FindFormat.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With Application.FindFormat.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
'Hard Code Red Boxes
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True
Application.Range("H13:H300").Select
Application.Selection.Copy
AppWord.Documents.Add
AppWord.Selection.Paste
AppWord.ActiveDocument.Tables(1).Range.Select
AppWord.Selection.Copy
AppWord.Quit
Application.CutCopyMode = False
Set AppWord = Nothing
Range("G13").Select
ActiveSheet.Paste
Range("H13").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub