Consulting

Results 1 to 19 of 19

Thread: Help with code to copy cell value before change event

  1. #1
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location

    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:

    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.

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,910
    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.)
    Last edited by p45cal; 12-03-2023 at 08:12 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,744
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location
    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!

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,910
    Quote Originally Posted by Rob5060 View Post
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location
    Quote Originally Posted by p45cal View Post
    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!

  7. #7
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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?
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  8. #8
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  9. #9
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location
    Quote Originally Posted by georgiboy View Post
    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
    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.

  10. #10
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  11. #11
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  12. #12
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Attached Files Attached Files
    Last edited by georgiboy; 12-06-2023 at 05:45 AM. Reason: typo
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  13. #13
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    Out of pure interest, was the above not a suitable option?
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  14. #14
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location
    Quote Originally Posted by georgiboy View Post
    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

  15. #15
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Attached Files Attached Files
    Last edited by georgiboy; 12-11-2023 at 03:30 AM.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  16. #16
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location
    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.
    Attached Files Attached Files

  17. #17
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    Try the attached.
    Attached Files Attached Files
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  18. #18
    VBAX Regular
    Joined
    Dec 2023
    Posts
    7
    Location
    Quote Originally Posted by georgiboy View Post
    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!!

  19. #19
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    You're welcome, thanks for the feedback.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •