VBA code randomly gets hung up on "ActiveSheet.Paste"

[willow1985]

A part of my code below randomly gets hung up on "ActiveSheet.Paste" I am not sure why. It will give me the standard run time error and if I select debug and just proceed to run the macro it runs just fine.
It is not a consistent error but enough to get other users not experienced users using this spreadsheet to panic.

Is there a reason/way of fixing this?

Columns("X:X").Select
    With Selection
        .WrapText = True
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("W1").Select
    If Application.CountIfs(Range("W:W"), "?*") > 1 Then
    Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$W$100000").AutoFilter Field:=23, Criteria1:="<>"
    LastRowColumnO = Cells(Rows.Count, 1).End(xlUp).Row
    Range("W2:X" & LastRowColumnO).Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Sheets("Dashboard").Select
    Range("A1").Select
ActiveSheet.Paste 'this is the line that gets hung up
    Selection.ShapeRange.Name = "CC"
    Selection.Name = "CC"
    Selection.ShapeRange.IncrementLeft 603
    Selection.ShapeRange.IncrementTop 181.5
    Range("W5").Select
    Sheets("CC").Select
    End If
    Cells.Select
    Selection.AutoFilter
    Range("A1").Select

Thank you

Carla

 

[Domenic]

Try pausing your macro for a few seconds after Selection.CopyPicture and before ActiveSheet.Paste. Also, usually, there's no need to use the Select method. And, I would suggest that you set the ScreenUpdating property to False at the beginning of the macro, and then set it back to True at the end. It should make things a bit more efficient. Try something like this...

Option Explicit

Sub test()

    Application.ScreenUpdating = False

    With Columns("X:X")
        .WrapText = True
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    Dim LastRowColumnO As Long
    If Application.CountIfs(Range("W:W"), "?*") > 1 Then
        LastRowColumnO = Cells(Rows.Count, 1).End(xlUp).Row 'last used row in Column A
        With ActiveSheet.Range("$A$1")
            .AutoFilter Field:=23, Criteria1:="<>"
            Range("W2:X" & LastRowColumnO).CopyPicture Appearance:=xlScreen, Format:=xlPicture
            .AutoFilter
        End With
        PauseMacro 3 'in seconds
        With Sheets("Dashboard")
            .Paste
            With .Shapes(.Shapes.Count)
                .Name = "CC"
                .IncrementLeft 603
                .IncrementTop 181.5
            End With
            .Select
        End With
    End If
   
    Application.ScreenUpdating = True
   
End Sub

Sub PauseMacro(ByVal secs As Single)
    Dim startTime As Single
    startTime = Timer
    Do
        DoEvents
    Loop Until Timer - startTime > secs
End Sub

Hope this helps!