I have a macro that fires on the "Worksheet_SelectionChange" event. The macro validate data of one column, it changes the background color of the cell if its wrong.
The problem is after run the macro, it clears the history of changes (Ctrl Z) of all the document, even the history changes of other cells that I didnt validate.
How can I solve this problem?
Thanks.
As the others have stated, there is not way to stop a worksheet-changing macro from clearing the undo stack.
As another side-effect, you can't undo the macro either without writing your own Undo routine, which can be a huge hassle.
Here's to hoping MS changes this in the future.
I had this issue and wound up having to create custom undo functionality. It works very similar to the native undo except for the following. I am sure they can be handled with a little more attention.
1) Custom undo does not undo formatting. Only text.
2) Custom undo goes all the way to end of the custom stack. Once this happens the stack is cleared and it does not toggle between the last two items like in the native undo functionality.
2.1) Does not have REDO functionality.
Download a working copy of this code.
Module UndoModule
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 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 Class Module UndoStackEntry
Public Address As String Public Value As Variant Also needed to attach to the following events on the WORKBOOK Excel 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 where you require undo to work should have the following code attached to 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