Wednesday, September 19, 2007

The Undo for Excel VBA

VBA Macros in Excel clear the Undo stack. The stack is not easily accessible. The following link provides a Macro undo routine:
 
 
This might be useful, but what about undoing previous actions when your VB "messes up the undo stack". The following code, which is loosely based on the link above - gives you a solution for that. It supports undo and redo, but has the following limitations:
 
1) You cannot undo formatting changes or cell-corner actions (double-click or drag).
2) It will only stacks a maximum of 1000 rows in a single change to avoid memory overflows.
3) To invoke a second undo action, you must at least change the cell selection.
 
I give you no warranty - use at own risk, but please give me and the original author credit for our work:
###################################################################################
Option Explicit
' Created by Gabriel Marcan (C) 2007
' I give you no warranty - use at own risk, but please give me and the original author credit for our work:
' Loosely based on http://j-walk.com/ss/excel/tips/tip23.htm
Public doList(10) As SavedRange
Public tempDo As SavedRange
Private isDo As Boolean
Public did As Boolean
Public bIndex As Integer
Public Const bLimit = 30
Public Type SavedRange
        Val As Variant
        isDo As Boolean
        RngName As String
        WsName As String
        WbName As String
End Type
Private Function ArraysEqual(a As Variant, b As Variant)
    On Error GoTo ReturnFalse
    Dim i As Integer
    Dim j As Integer
    If IsArray(a) And IsArray(b) Then
        For i = 1 To UBound(a, 1)
            For j = 1 To UBound(b, 2)
                If Not CStr(a(i, j)) = CStr(b(i, j)) Then GoTo ReturnFalse
            Next j
        Next i
        ArraysEqual = True
    Else
        If a = b Then ArraysEqual = True
    End If
    Exit Function
ReturnFalse:
    ArraysEqual = False
End Function
Sub MyDo()
     
    On Error GoTo NoDo
        If isDo Then MoveIndex
        If IsEmpty(doList(bIndex).Val) Then doList(bIndex).Val = ""
        did = True
        Dim rg As Range
        If doList(bIndex).WbName = "" Then Err.Raise 51, , "No History available"
        Set rg = Workbooks(doList(bIndex).WbName). _
                        Worksheets(doList(bIndex).WsName). _
                        Range(doList(bIndex).RngName)
        rg.Select
        If doList(bIndex).isDo = isDo Then Err.Raise 51, , "No History available"
        If ArraysEqual(rg.Value, doList(bIndex).Val) Then Err.Raise 51, , _
            "Cell corner actions (drag or double click) are not supported"
        rg.Formula = doList(bIndex).Val ' IsArray ubound
        If Not isDo Then MoveIndex
        did = False
       
        GoTo TheEnd
NoDo:
    Dim reun As String
    If isDo Then reun = "Re" Else reun = "Un"
   
    did = False
    If isDo Then
        isDo = False
        MoveIndex
    End If
   
    MsgBox "Cannot " + reun + "do. " + "More Details: " + Err.Description, , "Message"
    did = False
TheEnd:
        setupDo
End Sub
Public Sub Undo_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not did Then
        isDo = True
        tempDo.isDo = True
    End If
    If Not did Then MoveIndex
   
    doList(bIndex) = tempDo
   
    setupDo
End Sub
Public Sub MoveIndex()
    bIndex = bIndex + ((2 * Abs(CInt(isDo))) - 1)
    If (bIndex > bLimit) Then bIndex = 0
    If bIndex < 0 Then bIndex = bLimit
End Sub
Public Sub Undo_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
    On Error GoTo SkipSub
    tempDo.WbName = Sh.Parent.Name
    tempDo.WsName = Sh.Name
    tempDo.RngName = Target.Address
    tempDo.isDo = isDo
    If (Target.Rows.Count > 1000) Then
        tempDo.RngName = _
             CStr(Target.Cells(1, 1).Address) + ":" + _
             CStr(Target.Cells.SpecialCells(xlCellTypeLastCell).Address)
    End If
    tempDo.Val = Range(tempDo.RngName).Formula
SkipSub:
    setupDo
End Sub
Private Sub setupDo()
Application.OnUndo "Undo Last action", "MyUndo"
Application.OnRepeat "Redo Last action", "MyRedo"
End Sub
Sub MyUndo()
isDo = False
MyDo
End Sub
Sub MyRedo()
isDo = True
MyDo
End Sub
##############################################################################
 
Feel free to comment, suggests improvements or send me your feedback on this code.
 

6 comments:

  1. I'm looking for such a function and found your solution very interesting. However, after copy'n paste your code into my module, I can't get it work. I keep getting "Cannot undo. More Details: Subscript out of range" error message when I try to call MyDo macro. Any hint?

    ReplyDelete
  2. It has been some time since I ran through this code. First word of advise is to really try and avoid recreating the undo function. There are certain actions on ranges which will "destroy" the undo stack, while others will not. I managed to eventually avoid using this function - but it all depends on what you are trying to do.

    If you still want to continue with the code, check the pointer on the custom undo stack list: bIndex. There might be a glitch in the looping through the undo stack. Use the break option when the error occur and then call up the immediate window or use the watch list to monitor the variables.

    ReplyDelete
  3. This is a really handy bit of code. Thanks. It saved me quite some time writing something similar for myself.

    Regarding the previous comment, the first thing that I noticed is that your bLimit constant is set to 30, although the upper bound of the doList array is 10. That could cause a subscript out of range error or two.

    The only problem I am having is that you cannot seem to undo two or more actions in succession from the standard Edit, Undo menu option. If you want to undo further actions, you have to select the MyUndo macro 'manually'. I think perhaps you cannot use the application.onundo command within a macro that is being run as a result of the undo command itself!

    I'm not sure what you can do about that, but it isn't a problem for me, because I am putting this code into a bigger project which has its own drop-down menu, so I'll just add my own 'undo' and 'redo' options to that.

    Thanks again.

    ReplyDelete
  4. Excuse my ignorance but how do I integrate this into my macro? I understand how to do it with the original code but where do I call which sub in my macro?

    Thank you very much,

    Simon ;)

    ReplyDelete
  5. It's been a while, but as far as I can recall, you need to call the "setupDo()" routine before you want can start monitoring the undo/redo stack. Please also note that this was written for Excel 2003. There may be compatibility issues with 2007 / 2010. Best of luck.

    ReplyDelete
  6. Thanks for your quick reply Gabriel :)

    I tried doing that as below using the zerorange routine below but it just returns the message "Cannot Undo - No history available"

    I am using Excel 2007 .

    Blessings, Simon

    Sub ZeroRange()

    Dim i As Integer
    Dim cell As Range

    ' Inserts zero into all selected cells

    Application.EnableEvents = False



    ' Abort if a range isn't selected
    If TypeName(Selection) <> "Range" Then Exit Sub

    ' The next block of statements
    ' Save the current values for undoing
    ReDim OldSelection(Selection.count)
    Set OldWorkbook = ActiveWorkbook
    Set OldSheet = ActiveSheet
    i = 0
    For Each cell In Selection
    i = i + 1
    OldSelection(i).Addr = cell.Address
    OldSelection(i).Val = cell.Formula
    Next cell

    ' Insert 0 into current selection
    Application.ScreenUpdating = False
    Selection.Value = 0

    Application.EnableEvents = True

    setupDo

    ' Specify the Undo Sub

    End Sub

    ReplyDelete