'///////////////////////////////////////////////////////////
'///////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//////////////////////////////////

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////////////////////////////