Enabling the undo function in a macro enabled workbook

jpb103 · #1 06-03-2014, 12:01 PM

Hey fellas,

I have a macro-enabled workbook, which means the undo button is greyed out. I need the undo button. So I figure the best solution is to copy the worksheet to a hidden one for each change made, and then make the undo button show that saved worksheet. I'm not real sure on the syntax of saving copies of worksheets to hidden ones for this purpose. Any ideas, VBA community?

charlesdh · #2 06-03-2014, 01:35 PM

When I look at my Macro Enabled Workbook the "Undo" is not Grayed out.
So:
Is the sheet protected?
If so you need to unprotect it.

jpb103 · #3 06-04-2014, 05:00 AM

It is protected, yes. It must, however, remain protected in order to prevent certain locked cells from being modified. It is a protected worksheet with tracked changes enabled. I've made a macro that activates whenever a change is made to the worksheet. This is why undo is greyed out. When you use the Worksheet_Change function, VBA clears the undo stack. My solution to this is to save the worksheet to a hidden one before each change is made, and then restore it if the user wishes to undo an action. I just need some help on how to do this programatically.

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

jpb103 · #5 06-05-2014, 08:56 AM

Solved. Code follows:
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.ClearRedoLevel
Call ThisWorkbook.MakeUndoLevel
End Sub
'//////////////////////END//////////////////////////////////
 
'///////////////////////////////////////////////////////////
'///////Clear_Changes -> Set sheet 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_Selected_Cell -> 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
    'Clean up workbook by deleting hidden worksheets before close
    ActiveWorkbook.Application.DisplayAlerts = False
    If ActiveWorkbook.Sheets.Count > 1 Then
        For Counter = (ActiveWorkbook.Sheets.Count - 2) To 0 Step -1
            Sheets(CStr(Counter)).Delete
        Next
    End If
    ActiveWorkbook.Application.DisplayAlerts = True
End Sub
'////////////////////////////END////////////////////////////
 
'///////////////////////////////////////////////////////////
'//////Workbook_Open - Set initial undo/redo levels and/////
'////////////////save an initial undo level.////////////////
'///////////////////////////////////////////////////////////
Private Sub Workbook_Open()
    'Initialize global variables
    UndoLevel = 0
    RedoLevel = 0
    'Save a copy of initial worksheet
    Call MakeUndoLevel
End Sub
'////////////////////////////END////////////////////////////
 
'///////////////////////////////////////////////////////////
'//////MakeUndoLevel - Save a copy of the worksheet and/////
'/////////////////////////hide it.//////////////////////////
'///////////////////////////////////////////////////////////
Public Sub MakeUndoLevel()
    'Copy active worksheet
    Sheets("TBGS").Select
    Sheets("TBGS").Copy After:=Sheets(1)
    'Rename and hide copied worksheeet
    Sheets("TBGS (2)").Select
    Sheets("TBGS (2)").Name = CStr(UndoLevel)
    Sheets(CStr(UndoLevel)).Select
    ActiveWindow.SelectedSheets.Visible = False
    'Increment undo level
    UndoLevel = UndoLevel + 1
End Sub
'////////////////////////////END////////////////////////////
 
'///////////////////////////////////////////////////////////
'/////////UndoAction - undo the most recent change//////////
'///////////////////////////////////////////////////////////
Public Sub UndoAction()
If UndoLevel <> 1 Then
    'Restore last saved undo worksheet
    Sheets(CStr(UndoLevel - 2)).Copy After:=Sheets(1)
    Sheets((CStr(UndoLevel - 2) + " (2)")).Visible = True
    ActiveWorkbook.Application.DisplayAlerts = False
    Sheets("TBGS").Delete
    ActiveWorkbook.Application.DisplayAlerts = True
    Sheets((CStr(UndoLevel - 2) + " (2)")).Name = "TBGS"
    'Decrement undo level
    UndoLevel = UndoLevel - 1
    'Increment redo level
    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
    'Restore next saved redo worksheet
    Sheets(CStr(UndoLevel)).Visible = True
    ActiveWorkbook.Application.DisplayAlerts = False
    Sheets("TBGS").Delete
    ActiveWorkbook.Application.DisplayAlerts = True
    Sheets(CStr(UndoLevel)).Name = "TBGS"
    Call MakeUndoLevel
    'Decrement redo level
    RedoLevel = RedoLevel - 1
Else
    MsgBox "There is nothing to redo!"
End If
End Sub
'////////////////////////////END////////////////////////////
 
'///////////////////////////////////////////////////////////
'////////ClearRedoLevel - Sets the RedoLevel to 0///////////
'///////////////////////////////////////////////////////////
Public Sub ClearRedoLevel()
    Dim Counter As Long
    For Counter = (RedoLevel + UndoLevel - 1) To UndoLevel Step -1
        ActiveWorkbook.Application.DisplayAlerts = False
        'Delete saved redo worksheets
        Sheets(CStr(Counter)).Delete
        ActiveWorkbook.Application.DisplayAlerts = False
    Next
    RedoLevel = 0
End Sub
'////////////////////////////END////////////////////////////

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