Undo - solved

[Matjaz Prtenjak]

Hi,

Early in the morning I needed help in inplementing Undo command in VBA
macros. I posted a message named 'Undo ?' and soon after that Chip Pearson
respoded. T H A N K S!

With his idea I wrote simple class module with multilevel undu command. I
just discovered that Jennifer A. Campion also helped me and her code is
similar to mine.

etc, etc........

############# HERE IS THE MODUL #################
############# START OF VBA CLASS MODUL ##########

Option Explicit

' ***** Public functions
' SetUndo(ByVal obj As Object, ByVal rng As Range)
' GetUndo()

''' ******************************************************
'''
''' Modul's private declarations
'''
''' ******************************************************

Private Type typUndo ' new undo type - OLD CELL
address As String ' address of the cell
value As Variant ' value of the cell
End Type

Private Type typUndoLevel
size As Integer ' size of undo level
data() As typUndo ' undo data
End Type

Dim undoLevel As Integer ' level of undo information
Dim UnDo() As typUndoLevel ' whole undo information

''' ******************************************************
'''
''' P U B L I C F U N C T I O N S / P R E C E D U R E S
'''
''' ******************************************************

'''
'''
''' Procedure : SetUndo
''' Description : Copy range data to undoData (old values)
''' Return value: None
''' Arguments : rng : range with data
''' reset : if true than undolevel is reset to 1
''' Created : Matjaz Prtenjak, 11/10/1999
'''
Public Sub SetUndo(ByVal rng As Range, Optional reset As Boolean = False)
Dim cell
Dim counter As Long

' set level
If reset Then
undoLevel = 1
ReDim UnDo(undoLevel)
Else
undoLevel = undoLevel + 1
End If

' set tables
ReDim Preserve UnDo(undoLevel)
With UnDo(undoLevel)
.size = rng.Cells.Count
ReDim Preserve .data(.size)

counter = 1
For Each cell In rng.Cells
With .data(counter)
.address = cell.address(External:=True)
.value = cell.Formula
End With
counter = counter + 1
Next
End With
End Sub
'''
'''
''' Procedure : GetUndo
''' Description : Put the old values, previous saved by SetUndo in place
''' Return value: None
''' Arguments : None
''' Created : Matjaz Prtenjak, 11/10/1999
'''
Public Sub GetUndo()
On Error GoTo quit

Dim i As Long

If undoLevel = 0 Then Exit Sub

Application.ScreenUpdating = False
With UnDo(undoLevel)
For i = 1 To .size
Range(.data(i).address).Formula = .data(i).value
If i Mod 1000 = 0 Then DoEvents
Next
End With

' reset level
If undoLevel > 1 Then
undoLevel = undoLevel - 1
ReDim Preserve UnDo(undoLevel)
End If

quit:
Application.ScreenUpdating = True
End Sub

Private Sub Class_Initialize()
undoLevel = 0
End Sub

Private Sub Class_Terminate()
ReDim UnDo(1)
End Sub

############# START OF VBA CLASS MODUL ##########

############# USE ##########

Dim UnDo As New clsUndo
.........
Set UnDo = New clsUndo
.........
UnDo.SetUndo myRange
UnDo.SetUndo selection
UnDo.SetUndo .....

UnDo.GetUndo
UnDo.GetUndo
....

I know that there are some thinks that can be inpruved but that is all i
need in my macros and I will not work on it any more.

Have a nice day and thanks for all the help.
Matjaz Prtenjak
matjaz....@kovinotehna.si
Slovenija