Help with code to copy cell value before change event

[Rob5060]

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:


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.


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.

[p45cal]

try:
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.)

[Paul_Hossler]

I'd do something like this



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

[Rob5060]

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!

[p45cal]

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.

[Rob5060]

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!

[georgiboy]

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?

[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:

[Rob5060]

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.

[georgiboy]

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.

[georgiboy]

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.

[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

[georgiboy]

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

[Rob5060]

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.


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

[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 (http://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

[Rob5060]

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.

[georgiboy]

Try the attached.

[Rob5060]

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!!

[georgiboy]

You're welcome, thanks for the feedback.