Help. Macro works, but Excel is not responding well after running it

[Nico.L]

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? : pray2: 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

[Nico.L]

I found out..


Worksheets("Report").Columns("P:P").AutoFit

Because of this line.. it was Autofitting a column with no values.