Help with code to copy cell value before change event

[georgiboy]

I see, there is always a way around these things. I added your sort line to the Worksheet_Change event and added an index column (which I have hidden) in column C of Sheet1. I have also made the only place the target range is defined to the Workbook_Open sub.

As I can't see what you have in column A - with your sort, you may need to add that back in, I have made it only sort by one column to make it work with the example. I can help with this if you see this as an option.

ThisWorkbook module:

Option Explicit
Private Sub Workbook_Open()
    Dim endRow As Long
    
    Set tRng = Range("C5:E14") ' whole target range with index column
    
    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
    
    Set rngToProcess = Intersect(Target, Application.Index(tRng, , 2)) ' 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
        Application.UNDO ' undo your last entry
        Target.Offset(, 1).Value = Target.Value ' write the previous value to the cell to the right of target
        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.Offset(, -1) ' write the target index 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
        Target.Value = sNewValue ' write back the latest value you entered
        tRng.Sort tRng(1, 2), xlAscending, , , xlDescending ' sort the sort range
        Application.EnableEvents = True ' switch events back on
    End If
End Sub

Module 1:

Option Explicit
Public tRng As Range
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, indR As Long
    
    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
            indR = Application.Index(tRng, , 1).Find(wsU.Range("B" & x).Value).Row ' find the index number on sheet1
            Set rCell = ws1.Range("D" & indR) ' 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