Help with code to copy cell value before change event

[georgiboy]

Right, now I am not tipsy, I will show you an example of what I was "TRYING" to explain yesterday.

In the attached file I have included a sheet named "UNDO", this sheet can be hidden, I have left it visible so you can see what is going on. I have added code to @p45cal's code from post 2, this can be found in the "Sheet1" module & below. The "UNDO" macro I have created has been set to run with CTRL+U (this can be removed if required), I have also added a button to the sheet "Sheet1" that will fire the "UNDO" macro.

Code in the attached file is as below:

ThisWorkbook module:

Option Explicit
Private Sub Workbook_Open()
    ' Code from: georgiboy - www.vbaexpress.com - 06/12/2023    
    Dim endRow As Long
    
    With Sheets("UNDO") ' all code below that starts with a full stop (period in USA) will reference the UNDO sheet
        endRow = .Cells(Rows.Count, 1).End(xlUp).Row ' set end row of the UNDO sheet
        If endRow > 1 Then ' check if endRow is the header row, if it is then don't bother clearing the UNDO sheet
            .Range("A2:D" & endRow).ClearContents ' clear contents for every cell with data under the headings of the UNDO sheet
        End If
    End With
End Sub

Sheet1 module:

Option Explicit
Dim i As Long
Private Sub Worksheet_Change(ByVal Target As Range)
    ' Code from: p45cal - www.vbaexpress.com - 03/12/2023
    ' Edited by: georgiboy - www.vbaexpress.com - 06/12/2023
    Dim rngToProcess As Range, sNewValue, sOldValue
    Dim rCell As Range, nr As Long ' added by georgiboy
    
    Set rngToProcess = Intersect(Target, Range("C5:C14")) ' create a range from cells edited
    If Not rngToProcess Is Nothing Then ' check if the above range is empty
        Application.EnableEvents = False ' switch off events so there is not an infinite loop
        sNewValue = Target.Value ' get the value that was just entered
        sOldValue = Target.Offset(, 1).Value ' get the previous value, added by georgiboy
        Application.UNDO ' undo your last entry
        Target.Offset(, 1).Value = Target.Value ' write the previous value to the cell to the right of target
        '*'*'*' below added by georgiboy
        i = i + 1 ' increment the instance, used for the UNDO sub
        For Each rCell In rngToProcess ' loop through the cells in the target range
            With Sheets("UNDO") ' all code below that starts with a full stop (period in USA) will reference the UNDO sheet
                nr = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' get the next blank ro of the UNDO sheet
                .Range("A" & nr) = i ' write the instance number to the UNDO sheet
                .Range("B" & nr) = rCell.Address ' write the target address to the UNDO sheet
                .Range("C" & nr) = rCell.Offset(, 1).Value ' write what was the current value to the UNDO sheet
                .Range("D" & nr) = sOldValue ' write the existing previous value to the UNDO sheet
            End With
        Next rCell
        '*'*'*' above added by georgiboy
        Target.Value = sNewValue ' write back the latest value you entered
        Application.EnableEvents = True ' switch events back on
    End If
End Sub

Module 1:

Option Explicit
Sub UNDO()
    ' Code from: georgiboy - www.vbaexpress.com - 06/12/2023
    Dim wsU As Worksheet, ws1 As Worksheet
    Dim x As Long, wsUend As Long, inst As Long
    Dim rCell As Range
    
    Application.EnableEvents = False ' switch off events so that the code below does not trigger the Worksheet_Change event
    Set wsU = Sheets("UNDO") ' the hidden sheet named UNDO
    Set ws1 = Sheets("Sheet1") ' the sheet that will be undone
    wsUend = wsU.Cells(Rows.Count, 1).End(xlUp).Row ' end row of sheet UNDO
    On Error GoTo JumpOut ' if the next line of code produces an error then it will go to JumpOut at the bottom of this sub
        inst = wsU.Range("A" & wsUend).Value ' latest instance that was added to the UNDO sheet
    On Error GoTo 0 ' switch error state back on
    
    For x = wsUend To 2 Step -1 ' loop backwards through the UNDO sheet
        If wsU.Range("A" & x) = inst Then ' check if the current row on UNDO sheet was the lates instance
            Set rCell = ws1.Range(wsU.Range("B" & x)) ' create a reference range to the cell on ws1
            rCell.Value = wsU.Range("C" & x).Value ' write the previous value back to ws1
            rCell.Offset(, 1) = wsU.Range("D" & x).Value ' write the previous previous value back to ws1
            wsU.Range("A" & x & ":D" & x).ClearContents ' empty the row from the UNDO sheet, this allows you to have more undo's
        Else
            Exit For ' jump out as was not the last instance
        End If
    Next x
    Application.EnableEvents = True ' switch events back on
    Exit Sub
JumpOut:
    Application.EnableEvents = True ' switch events back on
    MsgBox "Nothing to undo", vbInformation, "UNDO"
End Sub

It looks like a lot of code but most of it is my annotation to try and help you understand what is going on - line by line.

Hope this helps