Looking at the problem I am suggesting following macro which you can try on the system of yours and see whether it is working or not.
Code:
Sub Phaser7400DXFTotalUserCost()
'
' Phaser7400DXFTotalUserCost Macro
' Macro recorded 6/12/2006 by Information Technology
'
' Keyboard Shortcut: Ctrl+Shift+M
'
Range("I1").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Sheet Cost"
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.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 = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Range("I2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]/RC[-6])*(RC[-1])"
Range("I2").Select
Selection.Copy
Range("I3:I39").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("H:H").Select
Selection.EntireColumn.Hidden = True
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Range("I1").Select
ActiveCell.FormulaR1C1 = "Account #"
Columns("J:J").Select
Selection.Style = "Currency"
Range("A1:J1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.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(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Columns("J:J").ColumnWidth = 9.71
Columns("I:I").ColumnWidth = 13.86
Columns("G:G").ColumnWidth = 10.71
Columns("F:F").ColumnWidth = 1.14
Columns("F:F").ColumnWidth = 0
Columns("D:D").ColumnWidth = 13.43
Columns("E:E").ColumnWidth = 13.71
Columns("C:C").ColumnWidth = 13.71
Columns("A:A").ColumnWidth = 12.57
Columns("B:B").ColumnWidth = 33.14
Cells.Select
Selection.AutoFilter
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("A7").Select
Application.WindowState = xlMinimized
ActiveSheet.Outline.ShowLevels RowLevels:=1
Range("B53").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveSheet.Outline.ShowLevels RowLevels:=3
Range("A7:J7,A9:J9,A11:J11,A15:J15").Select
Range("A15").Activate
ActiveWindow.SmallScroll Down:=9
Range("A7:J7,A9:J9,A11:J11,A15:J15,A22:J22,A29:J29,A44:J44,A46:J46,A48:J49"). _
Select
Range("A48").Activate
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("L32").Select
ActiveWindow.SmallScroll Down:=-12
ActiveWorkbook.Save
End Sub
Bookmarks