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? 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.