Hi all,
I am fairly new to VBA, so Im using "Record macro" a lot, which could be causing the problems. Sometimes when I am running the code everything is OK, but often it will go to a kind of slow motion mode where Excel will not be responding in the end. Here my only option is to CTRL+ALT+DELETE to restart Excel and try again.
Could any experts please spot something in my code that could cause this? I have uploaded the file it needs to run the code on at code is below:
Sub AVG()
Dim ReportLastcolumn As Long
Dim ReportLastrow As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim g As Long
Dim Report As Worksheet
Application.ScreenUpdating = False
Set Report = Workbooks("SRP BSA 447T.xlsx").Sheets("Report")
Report.Activate
ReportLastcolumn = Cells(14, Columns.Count).End(xlToLeft).Column
Cells(14, ReportLastcolumn + 1).Select
ActiveCell.EntireColumn.Select
Selection.ColumnWidth = 2
ActiveCell.Offset(13, -1).Range("A1:A3").Select
Selection.Copy
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
With Selection.Interior
.Pattern = xlSolid
.PatternColor = 0
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
ActiveCell.Select
ActiveCell.FormulaR1C1 = "'ABS Average"
ActiveCell.Range("A1:A3").Select
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1:B3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(-2, 1).Range("A1").Select
ReportLastcolumn = Cells(14, Columns.Count).End(xlToLeft).Column
x = 5 - ReportLastcolumn
Cells(17, ReportLastcolumn).Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(ABS(RC[" & x & "]:RC[-3]))"
Cells(17, ReportLastcolumn).AutoFill Cells(17, ReportLastcolumn).Resize(Cells(17, ReportLastcolumn - 2).End(xlDown).Row - 16)
Cells(17, ReportLastcolumn).EntireColumn.Select
Selection.Copy
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
ActiveSheet.Paste
ReportLastrow = Range("B" & Rows.Count).End(xlUp).Row
For g = 17 To ReportLastrow
Cells(g, ReportLastcolumn + 1).Value = Cells(g, ReportLastcolumn) / (ReportLastcolumn - 7)
Next g
Cells(17, ReportLastcolumn + 1).EntireColumn.Select
Selection.Copy
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
ActiveSheet.Paste
Cells(17, ReportLastcolumn + 1).EntireColumn.Delete
Range("E" & 17, "E" & ReportLastrow).Select
Selection.Copy
Cells(17, ReportLastcolumn).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For y = 17 To ReportLastrow
For z = 5 To ReportLastcolumn - 3
If Cells(y, z).Value > Cells(y, ReportLastcolumn) Then
Cells(y, z).Interior.Color = RGB(196, 215, 155)
End If
Next z
Next y
Worksheets("Report").Columns("P:P").AutoFit
Application.ScreenUpdating = True
End Sub