VBA taking 97% of system resources

P

puskacpj

Board Regular
Joined
Jul 29, 2011
Messages
102
Can anyone direct me to somewhere where I can see if I can reduce my code? It is Very very very lengthy and is taking up huge amounts of system resources. I even have to end task.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
This is it. I call each sub producedure. I have included the sub producure for New Defects Aged by Application. I then have basically the same repeated for Closed and Open and then each for Aging by Owner. I have a sneaking suspicion that I have a lot of unnecessary code. I also was looking at Do Events. Is that anything I should look at? Thank you
==========================================
Sub SLA_Aging_Calcs()
Sheets("New").Select
Range("A1").Select
Sheets("Closed").Select
Range("A1").Select
Sheets("Open").Select
Range("A1").Select
Call AppNew
Call AppClosed
Call AppOpen
Call OwnerNew
Call OwnerClosed
Call OwnerOpen
End Sub
Public Sub AppNew()
Dim MainWorksheet As Worksheet
Application.ScreenUpdating = False ' turn off the screen updating
Range("A1").Select
Sheets("New").Select
'Count total requests for last row with information
tot_new_row = Cells(Rows.Count, 1).End(xlUp).Row
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("New").Select
Cells.EntireColumn.AutoFit
Range("B1").Select
Columns("B:B").EntireColumn.AutoFit
Columns("A:I").Select
Selection.ColumnWidth = 12
Range("G1").Select
Columns("G:G").EntireColumn.AutoFit
Columns("J:J").Select
Selection.ColumnWidth = 111
Columns("K:L").Select
Selection.ColumnWidth = 12
ActiveWindow.SmallScroll ToRight:=-2
Columns("J:J").Select
Selection.ColumnWidth = 100
Cells.Select
Selection.RowHeight = 45
Range("A1:Q1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Columns("B:B").ColumnWidth = 13.71
Columns("B:B").ColumnWidth = 16.29
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs ("U:\QC\SystemReq_Report"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
Range("A2").Select
ActiveWindow.SmallScroll ToRight:=2
' Age the defects
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
ActiveCell.FormulaR1C1 = "Age"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]=""Closed"",RC[7]-RC[-1],TODAY()-RC[-1])"
Selection.NumberFormat = "0"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H" & tot_new_row), Type:=xlFillDefault
Sheets.Add After:=Sheets(Sheets.Count)

'Application New Summary
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Application New"
Columns("A:A").Select
Selection.ColumnWidth = 45
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"Quality Center Aging Report - By Application - [New Tickets]"
Range("A1:I3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A1").Select
With Selection.Font
.Name = "Calibri"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
' Severity 1-Critical New by Application
Range("A3").Select
ActiveCell.FormulaR1C1 = "Severity 1"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Age in Days"
Range("B3").Select
ActiveCell.FormulaR1C1 = "< 6"
Range("C3").Select
ActiveCell.FormulaR1C1 = "6 to 10"
Range("D3").Select
ActiveCell.FormulaR1C1 = "11 to 15"
Range("E3").Select
ActiveCell.FormulaR1C1 = "16 to 20"
Range("F3").Select
ActiveCell.FormulaR1C1 = "21 to 25"
Range("G3").Select
ActiveCell.FormulaR1C1 = "26 to 30"
Range("H3").Select
ActiveCell.FormulaR1C1 = "31+"
Range("I3").Select
ActiveCell.FormulaR1C1 = "Totals"
Range("R3").Select
'Copy New Applications and remove duplicates
tot_new_app = 0
Sheets("New").Select
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Application New").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$3:$A$355").RemoveDuplicates Columns:=1, Header:=xlYes
tot_new_app = Cells(Rows.Count, 1).End(xlUp).Row
tot_new_app = tot_new_app - 3
tot_new_place = tot_new_app + 3
Range("A4:I" & tot_new_place & "").Select
ActiveWorkbook.Worksheets("Application New").Sort.SortFields. _
Add Key:=Range("A4:A" & tot_new_place & ""), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Application New").Sort
.SetRange Range("A3:I" & tot_new_place & "")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,""<6.00"")"
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,"">=6.00"",New!R2C8:R" & tot_new_row & "C8,""<=10.99"")"
Range("D4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,"">=11.00"",New!R2C8:R" & tot_new_row & "C8,""<=15.99"")"
Range("E4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,"">=16.00"",New!R2C8:R" & tot_new_row & "C8,""<=20.99"")"
Range("F4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,"">=21.00"",New!R2C8:R" & tot_new_row & "C8,""<=25.99"")"
Range("G4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,"">=26.00"",New!R2C8:R" & tot_new_row & "C8,""<=30.99"")"
Range("H4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""1-Critical"",New!R2C8:R" & tot_new_row & "C8,"">=31.00"")"
Range("I4").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-7]:RC[-1])"
Range("B4:I4").Select
Selection.AutoFill Destination:=Range("B4:I" & tot_new_place & ""), Type:=xlFillDefault
tot_new_place = tot_new_place + 1
Range("A" & tot_new_place & "").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Totals"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
tot_new_cnt = tot_new_place - 1
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & tot_new_app & "]C:R[-1]C)"
Range("B" & tot_new_place & "").Select
Selection.AutoFill Destination:=Range("B" & tot_new_place & ":I" & tot_new_place & ""), Type:=xlFillDefault
Range("A" & tot_new_place & ":I" & tot_new_place & "").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
tot_new_place = tot_new_place + 2
tot_new_cnt = tot_new_cnt + 1
Range("J" & tot_new_cnt & "").Select
ActiveCell.FormulaR1C1 = "=IF(RC9=0, RC9=""No defects"", "" "" ) "
Rows("28:28").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 11
Range("A44").Select
' Severity 2-Major New by Application
Rows("3:" & tot_new_cnt & "").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=12
Range("A" & tot_new_place & "").Select
ActiveSheet.Paste
Range("A" & tot_new_place & "").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Severity 2"
tot_new_place = tot_new_place + 1
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,""<6.00"")"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,"">=6.00"",New!R2C8:R" & tot_new_row & "C8,""<=10.99"")"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,"">=11.00"",New!R2C8:R" & tot_new_row & "C8,""<=15.99"")"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,"">=16.00"",New!R2C8:R" & tot_new_row & "C8,""<=20.99"")"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,"">=21.00"",New!R2C8:R" & tot_new_row & "C8,""<=25.99"")"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,"">=26.00"",New!R2C8:R" & tot_new_row & "C8,""<=30.99"")"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""2-Major"",New!R2C8:R" & tot_new_row & "C8,"">=31.00"")"
tot_new_cnt = tot_new_place + tot_new_app - 1
Range("B" & tot_new_place & ":H" & tot_new_place & "").Select
Selection.AutoFill Destination:=Range("B" & tot_new_place & ":H" & tot_new_cnt & ""), Type:=xlFillDefault
tot_new_cnt = tot_new_cnt + 4
tot_new_place = tot_new_place - 1
'Range("J" & tot_new_cnt & "").Select
'ActiveCell.FormulaR1C1 = "=IF(RC9=0, ""No defects"", "" "" ) "
' Severity 3-Medium New by Application
Rows("" & tot_new_place & ":" & tot_new_cnt & "").Select
tot_new_cnt = tot_new_cnt + 3
Selection.Copy
ActiveWindow.SmallScroll Down:=12
tot_new_place = tot_new_place + tot_new_app + 3
Range("A" & tot_new_place & "").Select
ActiveSheet.Paste
Range("A" & tot_new_place & "").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Severity 3"
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "< 11"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "11 to 15"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "16 to 20"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "21 to 25"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "26 to 30"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "31 to 45"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "46+"
tot_new_place = tot_new_place + 1
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""3-Medium"",New!R2C8:R" & tot_new_row & "C8,""<11.00"")"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""3-Medium"",New!R2C8:R353C8,"">=11.00"",New!R2C8:R353C8,""<=15.99"")"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""3-Medium"",New!R2C8:R353C8,"">=16.00"",New!R2C8:R353C8,""<=20.99"")"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""3-Medium"",New!R2C8:R353C8,"">=21.00"",New!R2C8:R353C8,""<=25.99"")"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""3-Medium"",New!R2C8:R353C8,"">=26.00"",New!R2C8:R353C8,""<=30.99"")"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""3-Medium"",New!R2C8:R353C8,"">=31.00"",New!R2C8:R353C8,""<=45.99"")"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""3-Medium"",New!R2C8:R353C8,"">=46.00"")"
tot_new_cnt = tot_new_place + tot_new_app - 1
Range("B" & tot_new_place & ":H" & tot_new_place & "").Select
Selection.AutoFill Destination:=Range("B" & tot_new_place & ":H" & tot_new_cnt & ""), Type:=xlFillDefault
tot_new_cnt = tot_new_cnt + 4
tot_new_place = tot_new_place - 1
'Range("J" & tot_new_cnt & "").Select
'ActiveCell.FormulaR1C1 = "=IF(RC9=0, ""No defects"", "" "" ) "
' Severity 4-Low New by Application
Rows("" & tot_new_place & ":" & tot_new_cnt & "").Select
tot_new_cnt = tot_new_cnt + 3
Selection.Copy
ActiveWindow.SmallScroll Down:=12
tot_new_place = tot_new_place + tot_new_app + 3
Range("A" & tot_new_place & "").Select
ActiveSheet.Paste
Range("A" & tot_new_place & "").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Severity 4"
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "< 20"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "20 to 30"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "31 to 40"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "41 to 50"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "51 to 60"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "61 to 70"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "71+"
tot_new_place = tot_new_place + 1
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""4-Low"",New!R2C8:R" & tot_new_row & "C8,""<20.00"")"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""4-Low"",New!R2C8:R353C8,"">=20.00"",New!R2C8:R353C8,""<=30.99"")"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""4-Low"",New!R2C8:R353C8,"">=31.00"",New!R2C8:R353C8,""<=40.99"")"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""4-Low"",New!R2C8:R353C8,"">=41.00"",New!R2C8:R353C8,""<=50.99"")"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""4-Low"",New!R2C8:R353C8,"">=51.00"",New!R2C8:R353C8,""<=60.99"")"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""4-Low"",New!R2C8:R353C8,"">=61.00"",New!R2C8:R353C8,""<=70.99"")"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""4-Low"",New!R2C8:R353C8,"">=71.00"")"
tot_new_cnt = tot_new_place + tot_new_app - 1
Range("B" & tot_new_place & ":H" & tot_new_place & "").Select
Selection.AutoFill Destination:=Range("B" & tot_new_place & ":H" & tot_new_cnt & ""), Type:=xlFillDefault

tot_new_cnt = tot_new_cnt + 1
tot_new_place = tot_new_place - 1
' Range("J" & tot_new_cnt & "").Select
' ActiveCell.FormulaR1C1 = "=IF(RC9=0, ""No defects"", "" "" ) "
' Severity 5-Very Low New by Application
Rows("" & tot_new_place & ":" & tot_new_cnt & "").Select
tot_new_cnt = tot_new_cnt + 3
Selection.Copy
ActiveWindow.SmallScroll Down:=12
tot_new_place = tot_new_place + tot_new_app + 3
Range("A" & tot_new_place & "").Select
ActiveSheet.Paste
Range("A" & tot_new_place & "").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Severity 5"
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "< 20"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "20 to 30"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "31 to 40"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "41 to 50"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "51 to 60"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "61 to 70"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = "71+"
tot_new_place = tot_new_place + 1
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""5-Very Low"",New!R2C8:R" & tot_new_row & "C8,""<20.00"")"
Range("C" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""5-Very Low"",New!R2C8:R353C8,"">=20.00"",New!R2C8:R353C8,""<=30.99"")"
Range("D" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""5-Very Low"",New!R2C8:R353C8,"">=31.00"",New!R2C8:R353C8,""<=40.99"")"
Range("E" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""5-Very Low"",New!R2C8:R353C8,"">=41.00"",New!R2C8:R353C8,""<=50.99"")"
Range("F" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""5-Very Low"",New!R2C8:R353C8,"">=51.00"",New!R2C8:R353C8,""<=60.99"")"
Range("G" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""5-Very Low"",New!R2C8:R353C8,"">=61.00"",New!R2C8:R353C8,""<=70.99"")"
Range("H" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R353C3,RC1,New!R2C10:R353C10,""5-Very Low"",New!R2C8:R353C8,"">=71.00"")"
tot_new_cnt = tot_new_place + tot_new_app - 1
Range("B" & tot_new_place & ":H" & tot_new_place & "").Select
Selection.AutoFill Destination:=Range("B" & tot_new_place & ":H" & tot_new_cnt & ""), Type:=xlFillDefault
Range("A2").Select
tot_new_place = tot_new_place + 1
For i = 4 To tot_new_place
If Range("I" & i) = 0 Then

Range("I" & i).EntireRow.Hidden = True
Else
Range("I" & i).EntireRow.Hidden = False
End If
Next i
tot_new_cnt = tot_new_cnt - 2
tot_new_place = tot_new_place - 1

End Sub
 
Upvote 0
Just insert following two line code in SLA_Aging_Calcs procedure at the beginning:

Code: 
Application.displayalerts=false
Application.Screenupdating=False
 
Upvote 0
The first thing you can do is get rid of the Select statements. It's generally unnecessary to select objects in order to work with them, so when you see "Select" followed by "Selection" you can eliminate both statments and concatenate the remaining code.

As far as Excel is concerned, these first lines of code are unnecessary.

Code: 
Sheets("New").Select
Range("A1").Select
Sheets("Closed").Select
Range("A1").Select
Sheets("Open").Select
Range("A1").Select

You can also use With statements to streamline code, so this:

Code: 
Sheets("New").Select
'Count total requests for last row with information
tot_new_row = Cells(Rows.Count, 1).End(xlUp).Row
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
' other code... 
End With

Can be this:

Code: 
With Sheets("New")
  '  Count total requests for last row with information
     tot_new_row = .Cells(Rows.Count, 1).End(xlUp).Row
     With Cells
       .HorizontalAlignment = xlGeneral
       .VerticalAlignment = xlBottom
       '  Other code
     End with 
End With

This is just screen navigation and has no bearing on code other than slowing you down, so all of these can be eliminated:

Code: 
ActiveWindow.SmallScroll ToRight:=-2

Something like this:

Code: 
Range("B" & tot_new_place & "").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""5-Very Low"",New!R2C8:R" & tot_new_row & "C8,""<20.00"")"

Can simply be:

Code: 
Range("B" & tot_new_place & "").FormulaR1C1 = _
"=COUNTIFS(New!R2C3:R" & tot_new_row & "C3,RC1,New!R2C10:R" & tot_new_row & "C10,""5-Very Low"",New!R2C8:R" & tot_new_row & "C8,""<20.00"")"

That should get you started.
 
Upvote 0
This is what I began with but now the Sheet named New does not have any Formatting, Aging column... ????
----------------
Public Sub AppNew()
Dim MainWorksheet As Worksheet
Application.ScreenUpdating = False ' turn off the screen updating
With Sheets("New")
'Count total requests for last row with information
tot_new_row = Cells(Rows.Count, 1).End(xlUp).Row
With Cells
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
Cells.EntireColumn.AutoFit
End With
Columns("B:B").EntireColumn.AutoFit
Columns("A:I").Select
Selection.ColumnWidth = 12
Range("G1").Select
Columns("G:G").EntireColumn.AutoFit
Columns("J:J").Select
Selection.ColumnWidth = 111
Columns("K:L").Select
Selection.ColumnWidth = 12
Columns("J:J").Select
Selection.ColumnWidth = 100
Cells.Select
Selection.RowHeight = 45
Range("A1:Q1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Columns("B:B").ColumnWidth = 13.71
Columns("B:B").ColumnWidth = 16.29
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
End With
Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs ("U:\QC\SystemReq_Report"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
Range("A2").Select
'ActiveWindow.SmallScroll ToRight:=2
' Age the defects
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
ActiveCell.FormulaR1C1 = "Age"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]=""Closed"",RC[7]-RC[-1],TODAY()-RC[-1])"
Selection.NumberFormat = "0"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H" & tot_new_row), Type:=xlFillDefault
Sheets.Add After:=Sheets(Sheets.Count)
 
Upvote 0
Oops, that's a mess-up on my part. "With Cells" actually needs to be "With .Cells". Note the dot qualifier that ties it to the "New" sheet.

You still have some things like this:

Code: 
Columns("A:I").Select
Selection.ColumnWidth = 12

Which can just be: Columns("A:I").ColumnWidth = 12
 
Upvote 0
Hi

I started cleaning this up and it got a bit much. I got about halfway so you just need to apply the same to the rest. Sorry I couldn't finish it up, I'm heavy tired

Code: 
Public Sub AppNew()
Dim MainWorksheet As Worksheet
Dim tot_new_app As Long
Dim tot_new_place As Long

Application.ScreenUpdating = False ' turn off the screen updating
Application.DisplayAlerts = False

With Sheets("New")
'Count total requests for last row with information
tot_new_row = .Cells(Rows.Count, 1).End(xlUp).Row
    
    With .UsedRange
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .EntireColumn.AutoFit
        .RowHeight = 45
    End With
        .Columns("A:L").ColumnWidth = 12
        .Columns("J:J").ColumnWidth = 100
    With .Range("A1:Q1")
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 6299648
        End With
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .Bold = True
        End With
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
    End With
    .Columns("B:B").ColumnWidth = 16.29
' ActiveWorkbook.SaveAs ("U:\QC\SystemReq_Report"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
' Age the defects
    .Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    With .Range("H1")
        .FormulaR1C1 = "Age"
        With .Font
            .Name = "Calibri"
            .FontStyle = "Bold"
            .Size = 11
        End With
    End With
    With .Range("H2:H" & tot_new_row)
        .FormulaR1C1 = "=IF(RC[1]=""Closed"",RC[7]-RC[-1],TODAY()-RC[-1])"
        .NumberFormat = "0"
    End With
End With
Sheets.Add After:=Sheets(Sheets.Count)
'Application New Summary
With ActiveSheet
    .Name = "Application New"
    .Columns("A:A").ColumnWidth = 45
    .Range("A1").Value = "Quality Center Aging Report - By Application - [New Tickets]"
    With Range("A1:I3")
        With .Interior
            .Color = 6299648
        End With
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .Bold = True
            .Name = "Calibri"
            .Size = 16
        End With
    End With
' Severity 1-Critical New by Application
    .Range("A3") = "Severity 1"
    .Range("B2") = "Age in Days"
    .Range("B3") = "< 6"
    .Range("C3") = "6 to 10"
    .Range("D3") = "11 to 15"
    .Range("E3") = "16 to 20"
    .Range("F3") = "21 to 25"
    .Range("G3") = "26 to 30"
    .Range("H3") = "31+"
    .Range("I3") = "Totals"
End With
'So we get to here OK!!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Excel error "Ran out of Resources"
Replies
3
Views
66
Joe4
Joe4
J
  • Question
VB Macro for extracting Excel email address data to Outlook email draft
Replies
0
Views
181
Jaydee12
J
R
  • Question
XLookup or Match/Index? Unsure which to use
Replies
3
Views
130
Redd_Dayspring
R
S
  • Question
Updating "Templates"
Replies
0
Views
185
Skiier89
S
R
  • Question
Adding Additional ActiveX Control From OCX File
Replies
6
Views
287
Dan_W
D

Forum statistics

Threads
1,203,047
Messages
6,053,197
Members
444,645
Latest member
mee siam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top