Undo does not work when VBA code runs

[eli_m]

Hi,

I have this code that I can't undo or do a copy and paste action:

Private Sub Worksheet_Calculate() ' Ignore Errors after Sorting

Dim r As Range: Set r = Range("A2:AS200")
Dim cel As Range

For Each cel In r
  With cel
    .Errors(8).Ignore = True 'Data Validation Error
    .Errors(9).Ignore = True 'Inconsistent Error
    .Errors(6).Ignore = True 'Lock Error
  End With
Next cel

End Sub

Is there some way to make it work?

I only want that code to run when I sort my columns but it seems to be running with every change I make on my sheet.

Thanks in advance!

 

[eli_m]

my full code is below as there may be other actions that are stopping undo:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Application.Calculate
End If
End Sub

' Ignore Errors when Worksheet Activated
Private Sub Worksheet_Activate()

Dim r As Range: Set r = Range("A2:AS200")
Dim cel As Range

For Each cel In r
  With cel
    .Errors(8).Ignore = True 'Data Validation Error
    .Errors(9).Ignore = True 'Inconsistent Error
    .Errors(6).Ignore = True 'Lock Error
  End With
Next cel

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Const sURI As String = "https://test.com/cases/"

    'Conditions for event driven
    If Target.Count <> 1 Then Exit Sub
    If Not Intersect(Target, Range("Q3:Q200")) Is Nothing Then

        On Error GoTo ErrLine
        Application.EnableEvents = False

        'Add a Hyperlink
        If Target.Value <> "" Then    ' If Reference column is NOT blank
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(Target.Row, "A"), Address:= _
                                       sURI & Target.Value, TextToDisplay:=Cells(Target.Row, "A").Value
            'Set hyperlink text
            With Cells(Target.Row, "A").Font
                .Name = "Calibri"
                .Size = 12
                .Bold = True
                .Color = vbBlack
                .Underline = xlUnderlineStyleNone
            End With
        Else
            Cells(Target.Row, "A").Hyperlinks.Delete    'Delete Hyperlink when Q is empty
            With Cells(Target.Row, "A").Font
                .Name = "Calibri"
                .Size = 12
                .Bold = True
                .Color = vbBlack
                .Underline = xlUnderlineStyleNone
            End With
        End If
    End If

    If Target.CountLarge / Rows.Count = Int(Target.CountLarge / Rows.Count) Then Exit Sub    'Exit code if whole columns are edited

    ' Copy from Line 200 into deleted cells
    Dim Changed As Range, c As Range

    Set Changed = Intersect(Target, Columns("A:AS"))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        For Each c In Changed
            If Len(c.Text) = 0 Then Cells(200, c.Column).Copy Destination:=c
        Next c
        Application.EnableEvents = True
    End If

    ' Ignore Errors with Worksheet Clicks
    Dim r As Range: Set r = Range("A2:AS200")
    Dim cel As Range

    For Each cel In r
        With cel
            .Errors(8).Ignore = True    'Data Validation Error
            .Errors(9).Ignore = True    'Inconsistent Error
            .Errors(6).Ignore = True    'Lock Error
        End With
    Next cel

ErrLine:        'Just in case, enable event
    Application.EnableEvents = True

End Sub
' Auto Refresh Pivot Tables
Private Sub Worksheet_Deactivate()
  ThisWorkbook.RefreshAll

On Error Resume Next

End Sub