A reliable Multiple Undo/Redo

[docHoliday]

I found some code on the web for multiple undo/redo, but it only holds up to 1000x undo and then throws and out of boundaries error when undo 1001 tries to join the array. I tried writing a function that recycled an undo array when the max limit was reached, but it never replaced the contents of the array back into the text box correctly.

Anyone have or know where to find a reliable multiple undo/redo code snippet to use?

P.S. I've used the CAN_UNDO and UNDO API functions and they're just not versatile enough. I'm looking for at least 10x undo/redo.

[Nucleus]

Add a new class called clschanges then add this code:

Public ControlName As String
Public ControlValue As Variant


then add this to a form:

Private Const MAXCHANGES As Integer = 10 'change this value to increase/decrease buffer
 
Private Sub ClearChanges()
If colChanges.Count = 0 Then Exit Sub
Dim i%
For i = colChanges.Count To 1 Step -1
    colChanges.Remove i
Next i
End Sub
 
 
Private Sub AddChange(strControlName As String, varValue As Variant)
 
Dim objNewChange As New clsChanges
Dim objLastChange As New clsChanges
Dim i%
 
If colChanges.Count > 1 Then
    Set objLastChange = colChanges(colChanges.Count)
    
    If objLastChange.ControlName = strControlName And _
        objLastChange.ControlValue = varValue Then  ' check if new change = last change added
        Exit Sub
    Else
        objNewChange.ControlName = strControlName
        objNewChange.ControlValue = varValue
        colChanges.Add objNewChange
    End If
Else 'add initial entry to change collection
    objNewChange.ControlName = strControlName
    objNewChange.ControlValue = varValue
    colChanges.Add objNewChange
End If
 
    
If colChanges.Count > MAXCHANGES Then colChanges.Remove 1 ' if added one more than max allowed delete oldest entry
 
lngChangeBookmark = colChanges.Count ' resest bookmark to newest entry
 
Set objLastChange = Nothing
Set objNewChange = Nothing
End Sub
 
 
Private Sub Undo()
If colChanges.Count < 1 Or lngChangeBookmark < 2 Then Exit Sub ' no undo possible
Dim ctr As Control
    
    For Each ctr In Me.Controls
        If LCase(ctr.Name) = LCase(colChanges(lngChangeBookmark).ControlName) Then
            Select Case LCase(TypeName(ctr))
                Case "combobox"
                    While ctr.Name = colChanges(lngChangeBookmark).ControlName And _
                            ctr.ListIndex = colChanges(lngChangeBookmark).ControlValue And _
                            lngChangeBookmark > 1
                        lngChangeBookmark = lngChangeBookmark - 1
                    Wend
                    ctr.ListIndex = colChanges(lngChangeBookmark).ControlValue
                    Exit For
                
                Case "maskedbox", "textbox"
                    While ctr.Name = colChanges(lngChangeBookmark).ControlName And _
                            ctr.Text = colChanges(lngChangeBookmark).ControlValue And _
                            lngChangeBookmark > 1
                        lngChangeBookmark = lngChangeBookmark - 1
                    Wend
                    ctr.Text = colChanges(lngChangeBookmark).ControlValue
                    Exit For
                
                Case Else
                    MsgBox "Sub Undo() does not currently include the following control:" & LCase(TypeName(ctr)) & vbCrLf & "Please ammend."
            End Select
            End If
    Next ctr
    lngChangeBookmark = lngChangeBookmark - 1 ' reposition bookmark
End Sub
 
Private Sub Redo()
Dim ctr As Control
    If colChanges.Count = 0 Then Exit Sub ' no redo possible
    If lngChangeBookmark = colChanges.Count Then Exit Sub ' no redo possible
    
    lngChangeBookmark = lngChangeBookmark + 1 ' reposition bookmark
        
    For Each ctr In Me.Controls
        If LCase(ctr.Name) = LCase(colChanges(lngChangeBookmark).ControlName) Then
            Select Case LCase(TypeName(ctr))
                Case "combobox"
                    While ctr.Name = colChanges(lngChangeBookmark).ControlName _
                            And ctr.ListIndex = colChanges(lngChangeBookmark).ControlValue And _
                            lngChangeBookmark < MAXCHANGES
                        lngChangeBookmark = lngChangeBookmark + 1
                    Wend
                    ctr.ListIndex = colChanges(lngChangeBookmark).ControlValue
                    Exit For
                    
                Case "maskedbox", "textbox"
                    While ctr.Name = colChanges(lngChangeBookmark).ControlName And _
                            ctr.Text = colChanges(lngChangeBookmark).ControlValue And _
                            lngChangeBookmark < MAXCHANGES
                        lngChangeBookmark = lngChangeBookmark + 1
                    Wend
                    ctr.Text = colChanges(lngChangeBookmark).ControlValue
                    Exit For
                    
                Case Else
                    MsgBox "Sub Undo() does not currently include the following control:" & _
                            LCase(TypeName(ctr)) & vbCrLf & "Please ammend."
            End Select
        End If
    Next ctr
End Sub

Then in the got lost focus events for the controls you want to enable undo redo:

Private Sub txtTechBusPhone_GotFocus()
    varControlValue = Me.txtTechBusPhone.Text
End Sub
 
Private Sub txtTechBusPhone_LostFocus()
    If Me.txtTechBusPhone.Text <> varControlValue Then
        Call AddChange("txtTechBusPhone", varControlValue)
        Call AddChange("txtTechBusPhone", Me.txtTechBusPhone.Text)
    End If
End Sub

In Undo button:
Call Undo

In redo Button:
Call Redo


This is an old example that works with comboboxes, textboxes and masked textboxes; it should give you some good ideas.

[docHoliday]

Is colChanges a list box control or array or collection? I didn't see it declared in the example.

[DaoK]

I named a textbox : txtTechBusPhone

and
I have an error therer ? :

If colChanges.Count > 1 Then

[Nucleus]

I have created an example project to demonstrate the code I posted above which was missing a couple of declarations.