Cancel button clear history after running excel macro

Question

I have a macro that fires in the "Worksheet_SelectionChange" event. The macro checks the data of one column, it changes the background color of the cell, if it is wrong.

The problem is that after running the macro, it clears the change history (Ctrl Z) of the entire document, even the change history of other cells that I have not checked.

How can I solve this problem?

Thanks.

Answer 1

As others have argued, there is no way to stop changing the macro that changes the worksheet from clearing the undo stack.

As another side effect, you cannot cancel the macro either without writing your own Undo procedure, which can be a huge problem.

Here, to hope, MS will change this in the future.

Answer 2

I had this problem and I had to create custom undo functions. It works very similar to native cancellation, except for the following. I am sure that they can be dealt with with less attention.

1) Custom cancel does not cancel formatting. Only text.

2) User cancellation is fully completed before the end of the user stack. As soon as this happens, the stack is cleared and it does not switch between the last two elements, for example, in the undo function.

2.1) Does not have REDO functionality.

Download a working copy of this code

VBAProject Layout Screenshot

UndoModule Module

Public UndoStack() As UndoStackEntry Private Const UndoMaxEntries = 50 Public Sub SaveUndo(ByVal newUndo As UndoStackEntry) 'Save the last undo object If Not newUndo Is Nothing Then Call AddUndo(newUndo) End If End Sub Public Sub Undo() 'Appy last undo from the stack and remove it from the array Dim previousEdit As UndoStackEntry Set previousEdit = GetLastUndo() If Not previousEdit Is Nothing Then Dim previousEventState As Boolean: previousEventState = Application.EnableEvents Application.EnableEvents = False Range(previousEdit.Address).Select Range(previousEdit.Address).Value = previousEdit.Value Application.EnableEvents = previousEventState Call RemoveLastUndo End If End Sub Private Function AddUndo(newUndo As UndoStackEntry) As Integer If UndoMaxEntries < GetCount() Then Call RemoveFirstUndo End If On Error GoTo ErrorHandler ReDim Preserve UndoStack(UBound(UndoStack) + 1) Set UndoStack(UBound(UndoStack)) = newUndo AddUndo = UBound(UndoStack) ExitFunction: Exit Function ErrorHandler: ReDim UndoStack(0) Resume Next End Function Private Function GetLastUndo() As UndoStackEntry Dim undoCount As Integer: undoCount = GetCount() If undoCount > 0 Then Set GetLastUndo = UndoStack(undoCount - 1) End If End Function Private Function RemoveFirstUndo() As Boolean On Error GoTo ExitFunction RemoveFirstUndo = False Dim i As Integer For i = 1 To UBound(UndoStack) Set UndoStack(i - 1) = UndoStack(i) Next i ReDim Preserve UndoStack(UBound(UndoStack) - 1) RemoveFirstUndo = True ExitFunction: Exit Function End Function Private Function RemoveLastUndo() As Boolean RemoveLastUndo = False Dim undoCount As Integer: undoCount = GetCount() If undoCount > 1 Then ReDim Preserve UndoStack(undoCount - 2) RemoveLastUndo = True ElseIf undoCount = 1 Then Erase UndoStack RemoveLastUndo = True End If End Function Private Function GetCount() As Long GetCount = 0 On Error Resume Next GetCount = UBound(UndoStack) + 1 End Function 

UndoStackEntry class module

  Public Address As String Public Value As Variant 

You must also connect to the following events in the Excel WORKBOOK object.

 Public Sub WorkbookUndo() On Error GoTo ErrHandler ThisWorkbook.ActiveSheet.PageUndo ErrExit: Exit Sub ErrHandler: On Error GoTo ErrExit Application.Undo Resume ErrExit End Sub 

Finally, each sheet on which you want to cancel the job must have the following code associated with its events.

 Dim tmpUndo As UndoStackEntry Dim pageUndoStack() As UndoStackEntry Private Sub OnSelectionUndoCapture(ByVal Target As Range) Set tmpUndo = New UndoStackEntry tmpUndo.Address = Target.Address tmpUndo.Value = Target.Value UndoModule.UndoStack = pageUndoStack End Sub Private Sub OnChangeUndoCapture(ByVal Target As Range) Application.OnKey "^{z}", "ThisWorkbook.WorkbookUndo" Application.OnUndo "Undo Procedure", "ThisWorkbook.WorkbookUndo" If Not Application.Intersect(Target, Range(tmpUndo.Address)) Is Nothing Then If Target.Value <> tmpUndo.Value Or Empty = Target.Value Then UndoModule.UndoStack = pageUndoStack Call UndoModule.SaveUndo(tmpUndo) pageUndoStack = UndoModule.UndoStack End If End If End Sub Public Sub PageUndo() UndoModule.UndoStack = pageUndoStack Call UndoModule.Undo pageUndoStack = UndoModule.UndoStack End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Stash away the value of the first cell in the selected range On Error Resume Next Call OnSelectionUndoCapture(Target) oldValue = Target.Value End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False If tmpUndo.Value <> Target.Value Then 'Do some stuff End If Call OnChangeUndoCapture(Target) Application.ScreenUpdating = True Application.EnableEvents = True End Sub