Help with code to copy cell value before change event

I'm trying to get code to work for a range of cells but so far I've had no luck getting it to work. I have code that works for a single cell but can't get anything to work for the range.

I have dates in column C, rows 5-14. What I'm trying to accomplish is that anytime the date in any one of those cells changes, the original date is copied and then placed inside the cell directly to the right, in column D. So if cell C5 is 12/1/23 and I change the date to 12/5/23, the original date is copied prior to the change and then places that date (12/1/23) into cell D5.

Here is the code that I have working when applied to just cells C5 and D5:

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Address = Range("C5").Address Then
        Application.EnableEvents = False
        Dim sOldValue As String, sNewValue As String
        sNewValue = Target.Value
        Application.Undo
        sOldValue = Range("C5").Value
        Target.Value = sNewValue
        Worksheets("Sheet1").Range("D5") = sOldValue
        Application.EnableEvents = True
    End If


End Sub

---

This code does exactly what I'm looking for but need to get it to where it works for all of the cells in column C when any one of them are changed. I've tried modifying the code above to ("C5:C14") and ("D5:D14") with no luck and also tried this code below, also with no luck.

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Address = Range("C5:C14").Address Then
        Application.EnableEvents = False
        Dim sOldValue As String, sNewValue As String
        sNewValue = Target.Value
        Application.Undo
        Dim rOld As Range
        Set rOld = Range("C5:C14").Value
        Target.Value = sNewValue
        Range("D5:D14").Value = rOld.Value
        Application.EnableEvents = True
    End If


End Sub

---

I've searched all over and have found some similar topics, but nothing has really fit for what I'm attempting to do. Any help is greatly appreciated.

try:

Code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngToProcess As Range, sNewValue
Set rngToProcess = Intersect(Target, Range("C5:C14"))
If Not rngToProcess Is Nothing Then
  Application.EnableEvents = False
  sNewValue = Target.Value
  Application.Undo
  Target.Offset(, 1).Value = Target.Value
  Target.Value = sNewValue
  Application.EnableEvents = True
End If
End Sub

---

If you have problems with multiple cells being changed at once (say by copying data from another range, or from selecting a range and holding down the Ctrl key while Entering a value) come back. (In my quick testing I had no problems with multiple cell changes at once.)

I'd do something like this

Code:

---

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rCell As Range
    Dim vOldValue As Variant, vNewValue As Variant

    Set rCell = Target.Cells(1, 1)


    If Intersect(rCell, Range("C5:C14")) Is Nothing Then Exit Sub
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
       
    With rCell
        vNewValue = .Value
        Application.Undo
       
        vOldValue = .Value
        .Value = vNewValue
       
        If Len(vOldValue) > 0 Then
            .Offset(0, 1).Value = vOldValue
        Else
            .Offset(0, 1).ClearContents
        End If
    End With
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True


End Sub

---

Thank you both for your help on this! I tested the code provided by each of you and they both did exactly what I was looking for. I should have asked this before but unfortunately didn't think of it. I know that by adding VBA it removes the "undo" option. Is there a way to re-enable this feature with additional code? Just thinking it would be nice to have that as an option in case a change was made to the wrong row by mistake and an easy fix would be to just undo the change rather than trying to remember the previous values. If not, it's not a big deal, just something that dawned on me as I was testing the code. Thanks again for your help on this!

Quote:

---

Originally Posted by Rob5060

removes the "undo" option. Is there a way to re-enable this feature with additional code?

---

I explored this years ago and I didn't find a way, so I doubt it.

Quote:

---

Originally Posted by p45cal

I explored this years ago and I didn't find a way, so I doubt it.

---

I had a feeling it wasn't going to be possible but figured I'd ask anyway. Thank you again for the help!

I've had a couple of beers so I may be about to write something stupid but..

If the previous value has been stored in the cell to the right of the target cell, could we store the target row in a global variable and create a kind of undo macro that would put the old value back into the target cell and clear the cell to the right?

That macro could then be assigned to a keyboard shortcut. I understand that it would only undo the last change but would it be better than nothing?

Taking that idea further, there could be a hidden sheet that is cleared with a workbook-open event that stored the addresses of the changed cells with their respective old values next to them. Each time the undo macro was run it would work its way backwards through the hidden sheet and put the old values back in the main sheet and then clear the latest entry to the hidden sheet, thus creating a large amount of undo possibilities.

Sorry if I am blabbering :rofl:

Quote:

---

Originally Posted by georgiboy

Taking that idea further, there could be a hidden sheet that is cleared with a workbook-open event that stored the addresses of the changed cells with their respective old values next to them. Each time the undo macro was run it would work its way backwards through the hidden sheet and put the old values back in the main sheet and then clear the latest entry to the hidden sheet, thus creating a large amount of undo possibilities.

Sorry if I am blabbering :rofl:

---

Not blabbering at all. Both of your posts sound like good ideas and I would think are doable. Unfortunately I'm still pretty new to VBA and still learning, so this would be out of my current skillset. I've got my worksheet working exactly how I imagined to to work, but then the thought of the undo option hit me and wondering if it would even be a possibility. It's something that I'm going to have to research more to figure out how to do.

It would not undo any formatting, only values.

Secondly it would probably be best to keep it to only being able to undo values in the range "C5:C14".

When you referred to 'undo' I wasn't sure if you meant for the whole sheet or just your specific range of "C5:C14"?

If you wanted it to work for the sheet tli suppose that would depend how heavily used the sheet is, I.e. are you pasting large blocks of data or if one cell is edited at a time?

If it was to clear the old values out that are stored next to the target cell then it would most certainly need to be restricted to your range of "C5:C14" if that makes sense.

I, or someone else could look at this but I am only on my phone at the moment.

I suppose it could work for the whole sheet if intersect was used in the undo macro to work out if the cell to the right of the target needs to be cleared or not.

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:

Code:

---

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:

Code:

---

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:

Code:

---

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

Out of pure interest, was the above not a suitable option?

Quote:

---

Originally Posted by georgiboy

Out of pure interest, was the above not a suitable option?

---

I'm sorry, I had attempted to post a reply and just realized that it never actually posted. What you provided is amazing and does exactly what I was originally thinking. The only issue I ran into was using it with my existing code.

The code that I have sorts the rows based on the values in columns C and A. The issue now is, when I update the date in C6 it will kick that row down to C14, but if I hit the undo button it puts the old values back into what is now in C6 even though that wasn't the original row/cell that was changed. If that makes sense.

This is the code that I have to sort the sheet.

Code:

---

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("A5").CurrentRegion.Offset(1).Sort [C5], xlAscending, [A5], , xlDescending
End Sub

---

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:

Code:

---

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:

Code:

---

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:

Code:

---

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

---

Looking at your sheet it actually looks good and it appears that it sorts like I'm looking for. When the "Undo" button is clicked it changes back the correct cells after they were sorted. Is there a way to have the sort code run again after the undo button is clicked, putting the row back in the original spot?

I've attached an example sheet so you can see exactly what it looks like. The amount of rows could change but other than that, the layout stays the same. In the attachment the sheet acts exactly like I was aiming to do, without the "undo" button. The columns sort by the date in column C and then by the number in column A. What would be ideal is if I change the date in row 8, for example, to the current date then it kicks that row to the bottom. Then if I hit "undo" it changes the dates in columns C and D back but then the list sorts itself again, just like it does now if I change a date and then manually change it back.

Try the attached.

Quote:

---

Originally Posted by georgiboy

Try the attached.

---

I finally had a chance to try out your file and it works great! It appears to sort just as it should when values are changed and then goes right back to where it was originally when the undo button is clicked. Thank you very much for your help with this, I really appreciate it!!

You're welcome, thanks for the feedback.