Enabling the undo function in a macro enabled workbook

jpb103 · #4 06-04-2014, 10:44 AM

Here is what I have so far. The undo and redo kind of work...some of the time. The real problem is when you undo a pile of actions and then try redoing them. Or if you undo something and then perform an action, it does not clear the redo.
Worksheet code:

Code:

'///////////////////////////////////////////////////////////
'///////WorkSheet_Change - Highlight changed cells//////////
'///////////////////////////////////////////////////////////
Private Sub Worksheet_Change(ByVal Target As Range)
'Set range
Const WS_RANGE As String = "A12:AG100"
'Error handler
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
    With Target
        With .Interior
            'Set cell fill color on change
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
        End With
    End With
End If
ws_exit:
Application.EnableEvents = True
'Save worksheet for undo
Call ThisWorkbook.MakeUndoLevel
End Sub
'//////////////////////END//////////////////////////////////
'///////////////////////////////////////////////////////////
'////////Clear_Changes -> Revert cell color to none/////////
'///////////////////////////////////////////////////////////
Sub Clear_Changes()
    'Set range
    Range("A12:AG100").Select
    With Selection.Interior
        'Set fill color to none for cell range
        .Pattern = xlNone
    End With
End Sub
'//////////////////////END//////////////////////////////////
'///////////////////////////////////////////////////////////
'////////Clear_Changes -> Revert cell color to none/////////
'///////////////////////////////////////////////////////////
Sub Clear_Selected_Cell()
    With Selection.Interior
        .Pattern = xlNone
    End With
End Sub
'//////////////////////END//////////////////////////////////

Workbook code:

Code:

Option Explicit
'Declare global variables
Dim UndoLevel As Long
Dim RedoLevel As Long
'///////////////////////////////////////////////////////////
'//////Workbook_BeforeClose - Delete undo/redo worksheets///
'///////////////////////////////////////////////////////////
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Counter As Long
    ActiveWorkbook.Application.DisplayAlerts = False
    For Counter = (UndoLevel - 1) To 0 Step -1
        Sheets(CStr(Counter)).Delete
    Next
    ActiveWorkbook.Application.DisplayAlerts = True
End Sub
'////////////////////////////END////////////////////////////
'///////////////////////////////////////////////////////////
'//////Workbook_Open - Set initial undo/redo levels and/////
'////////////////save an initial undo level.////////////////
'///////////////////////////////////////////////////////////
Private Sub Workbook_Open()
    UndoLevel = 0
    RedoLevel = 0
    Call MakeUndoLevel
End Sub
'////////////////////////////END////////////////////////////
'///////////////////////////////////////////////////////////
'//////MakeUndoLevel - Save a copy of the worksheet and/////
'/////////////////////////hide it.//////////////////////////
'///////////////////////////////////////////////////////////
Public Sub MakeUndoLevel()
    Sheets("TBGS").Select
    Sheets("TBGS").Copy After:=Sheets(1)
    Sheets("TBGS (2)").Select
    Sheets("TBGS (2)").Name = CStr(UndoLevel)
    Sheets(CStr(UndoLevel)).Select
    ActiveWindow.SelectedSheets.Visible = False
    UndoLevel = UndoLevel + 1
End Sub
'////////////////////////////END////////////////////////////
'///////////////////////////////////////////////////////////
'/////////UndoAction - undo the most recent change//////////
'///////////////////////////////////////////////////////////
Public Sub UndoAction()
If UndoLevel <> 1 Then
    Sheets(CStr(UndoLevel - 2)).Visible = True
    ActiveWorkbook.Application.DisplayAlerts = False
    Sheets("TBGS").Delete
    ActiveWorkbook.Application.DisplayAlerts = True
    Sheets(CStr(UndoLevel - 2)).Name = "TBGS"
    Sheets(CStr(UndoLevel - 1)).Name = CStr(UndoLevel - 2)
    UndoLevel = UndoLevel - 1
    RedoLevel = RedoLevel + 1
Else
    MsgBox "There is nothing to undo!"
End If
End Sub
'////////////////////////////END////////////////////////////
'///////////////////////////////////////////////////////////
'//////RedoAction - redo a change that has been undone//////
'///////////////////////////////////////////////////////////
Public Sub RedoAction()
If RedoLevel <> 0 Then
    Sheets(CStr(UndoLevel - 1)).Visible = True
    Sheets("TBGS").Name = "Temp"
    Sheets("Temp").Visible = False
    Sheets(CStr(UndoLevel - 1)).Name = "TBGS"
    Sheets("Temp").Name = CStr(UndoLevel - 1)
    Call MakeUndoLevel
    RedoLevel = RedoLevel - 1
Else
    MsgBox "There is nothing to redo!"
End If
End Sub
'////////////////////////////END////////////////////////////

I'm getting there, just a few little things to clean up. I'll post completed code if/when I get it working to my satisfaction

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
custom icon, undo/redo for macro, permanent macro	Rapier	Excel	0	08-05-2013 06:30 AM
Saving as ( PowerPoint Macro-Enabled Slide Show )??	delete123	PowerPoint	2	04-10-2013 05:38 AM
Macro-enabled Template	ReviTULize	Word VBA	4	02-01-2013 01:46 PM
strangeness in undo function?	jeffk	Word	5	12-11-2012 10:25 AM
macro to transfer data from one workbook to another workbook	virsojour	Excel Programming	5	02-01-2011 08:58 PM