如何在 Excel VBA 中获取已更改单元格的旧值？

Question

I'm detecting changes in the values of certain cells in an Excel spreadsheet like this...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim old_value As String
Dim new_value As String

For Each cell In Target

    If Not (Intersect(cell, Range("cell_of_interest")) Is Nothing) Then
        new_value = cell.Value
        old_value = ' what here?
        Call DoFoo (old_value, new_value)
    End If

Next cell

End Sub

Assuming this isn't too bad a way of coding this, how do I get the value of the cell before the change?

Answer 1

try this

declare a variable say

Dim oval

and in the SelectionChange Event

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oval = Target.Value
End Sub

and in your Worksheet_Change event set

old_value = oval

Answer 2

You can use an event on the cell change to fire a macro that does the following:

vNew = Range("cellChanged").value
Application.EnableEvents = False
Application.Undo
vOld = Range("cellChanged").value
Range("cellChanged").value = vNew
Application.EnableEvents = True 

Answer 3

I had to do it too. I found the solution from "Chris R" really good, but thought it could be more compatible in not adding any references. Chris, you talked about using Collection. So here is another solution using Collection. And it's not that slow, in my case. Also, with this solution, in adding the event "_SelectionChange", it's always working (no need of workbook_open).

Dim OldValues As New Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Copy old values
    Set OldValues = Nothing
    Dim c As Range
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Local Error Resume Next  ' To avoid error if the old value of the cell address you're looking for has not been copied
    Dim c As Range
    For Each c In Target
        Debug.Print "New value of " & c.Address & " is " & c.Value & "; old value was " & OldValues(c.Address)
    Next c
    'Copy old values (in case you made any changes in previous lines of code)
    Set OldValues = Nothing
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c
End Sub

Answer 4

I have an alternative solution for you. You could create a hidden worksheet to maintain the old values for your range of interest.

Private Sub Workbook_Open()

Dim hiddenSheet As Worksheet

Set hiddenSheet = Me.Worksheets.Add
hiddenSheet.Visible = xlSheetVeryHidden
hiddenSheet.Name = "HiddenSheet"

'Change Sheet1 to whatever sheet you're working with
Sheet1.UsedRange.Copy ThisWorkbook.Worksheets("HiddenSheet").Range(Sheet1.UsedRange.Address)

End Sub

Delete it when the workbook is closed...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
Me.Worksheets("HiddenSheet").Delete
Application.DisplayAlerts = True

End Sub

And modify your Worksheet_Change event like so...

For Each cell In Target

    If Not (Intersect(cell, Range("cell_of_interest")) Is Nothing) Then
        new_value = cell.Value
        ' here's your "old" value...
        old_value = ThisWorkbook.Worksheets("HiddenSheet").Range(cell.Address).Value
        Call DoFoo(old_value, new_value)
    End If

Next cell

' Update your "old" values...
ThisWorkbook.Worksheets("HiddenSheet").UsedRange.Clear
Me.UsedRange.Copy ThisWorkbook.Worksheets("HiddenSheet").Range(Me.UsedRange.Address)

Answer 5

Here's a way I've used in the past. Please note that you have to add a reference to the Microsoft Scripting Runtime so you can use the Dictionary object - if you don't want to add that reference you can do this with Collections but they're slower and there's no elegant way to check .Exists (you have to trap the error).

Dim OldVals As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
    For Each cell In Target
        If OldVals.Exists(cell.Address) Then
            Debug.Print "New value of " & cell.Address & " is " & cell.Value & "; old value was " & OldVals(cell.Address)
        Else
            Debug.Print "No old value for " + cell.Address
        End If
        OldVals(cell.Address) = cell.Value
    Next
End Sub

Like any similar method, this has its problems - first off, it won't know the "old" value until the value has actually been changed. To fix this you'd need to trap the Open event on the workbook and go through Sheet.UsedRange populating OldVals. Also, it will lose all its data if you reset the VBA project by stopping the debugger or some such.

Answer 6

an idea ...

• write these in the ThisWorkbook module
• close and open the workbook

Public LastCell As Range

    Private Sub Workbook_Open()

        Set LastCell = ActiveCell

    End Sub

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

        Set oa = LastCell.Comment

        If Not oa Is Nothing Then
        LastCell.Comment.Delete
        End If

        Target.AddComment Target.Address
        Target.Comment.Visible = True
        Set LastCell = ActiveCell

    End Sub

Answer 7

Place the following in the CODE MODULE of a WORKSHEET to track the last value for every cell in the used range:

Option Explicit

Private r As Range
Private Const d = "||"

Public Function ValueLast(r As Range)
    On Error Resume Next
    ValueLast = Split(r.ID, d)(1)
End Function

Private Sub Worksheet_Activate()
    For Each r In Me.UsedRange: Record r: Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each r In Target: Record r: Next
End Sub

Private Sub Record(r)
    r.ID = r.Value & d & Split(r.ID, d)(0)
End Sub

And that's it.

This solution uses the obscure and almost never used Range.ID property, which allows the old values to persist when the workbook is saved and closed.

At any time you can get at the old value of a cell and it will indeed be different than a new current value:

With Sheet1
    MsgBox .[a1].Value
    MsgBox .ValueLast(.[a1])
End With

Answer 8

try this, it will not work for the first selection, then it will work nice :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo 10
    If Target.Count > 1 Then GoTo 10
    Target.Value = lastcel(Target.Value)
    10
End Sub


Function lastcel(lC_vAl As String) As String
    Static vlu
    lastcel = vlu
    vlu = lC_vAl
End Function

Answer 9

I had a need to capture and compare old values to the new values entered into a complex scheduling spreadsheet. I needed a general solution which worked even when the user changed many rows at the same time. The solution implemented a CLASS and a COLLECTION of that class.

The class: oldValue

Private pVal As Variant
Private pAdr As String
Public Property Get Adr() As String
   Adr = pAdr
End Property
Public Property Let Adr(Value As String)
    pAdr = Value
End Property
Public Property Get Val() As Variant
   Val = pVal
End Property
Public Property Let Val(Value As Variant)
   pVal = Value
End Property

There are three sheets in which i track cells. Each sheet gets its own collection as a global variable in the module named ProjectPlan as follows:

Public prepColl As Collection
Public preColl As Collection
Public postColl As Collection
Public migrColl As Collection

The InitDictionaries SUB is called out of worksheet.open to establish the collections.

Sub InitDictionaries()
    Set prepColl = New Collection
    Set preColl = New Collection
    Set postColl = New Collection
    Set migrColl = New Collection
End Sub

There are three modules used to manage each collection of oldValue objects they are Add, Exists, and Value.

Public Sub Add(ByRef rColl As Collection, ByVal sAdr As String, ByVal sVal As Variant)
    Dim oval As oldValue
    Set oval = New oldValue
    oval.Adr = sAdr
    oval.Val = sVal
    rColl.Add oval, sAdr
End Sub

Public Function Exists(ByRef rColl As Collection, ByVal sAdr As String) As Boolean
   Dim oReq As oldValue
   On Error Resume Next
   Set oReq = rColl(sAdr)
   On Error GoTo 0

   If oReq Is Nothing Then
      Exists = False
   Else
      Exists = True
   End If
End Function
Public Function Value(ByRef rColl As Collection, ByVal sAdr) As Variant
   Dim oReq As oldValue
   If Exists(rColl, sAdr) Then
      Set oReq = rColl(sAdr)
      Value = oReq.Val
   Else
      Value = ""
   End If
End Function

The heavy lifting is done in the Worksheet_SelectionChange callback. One of the four is shown below. The only difference is the collection used in the ADD and EXIST calls.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim mode As Range
   Set mode = Worksheets("schedule").Range("PlanExecFlag")
   If mode.Value = 2 Then
      Dim c As Range
      For Each c In Target
          If Not ProjectPlan.Exists(prepColl, c.Address) Then
             Call ProjectPlan.Add(prepColl, c.Address, c.Value)
          End If
      Next c
   End If
End Sub

THe VALUE call is called out of code executed from the Worksheet_Change Callback for example. I need to assign the correct collection based on the sheet name:

   Dim rColl As Collection
   If sheetName = "Preparations" Then
       Set rColl = prepColl
   ElseIf sheetName = "Pre-Tasks" Then
       Set rColl = preColl
   ElseIf sheetName = "Migr-Tasks" Then
       Set rColl = migrColl
   ElseIf sheetName = "post-Tasks" Then
       Set rColl = postColl
   Else
   End If

and then i am free to compute compare the some current value to the original value.

If Exists(rColl, Cell.Offset(0, 0).Address) Then
   tsk_delay = Cell.Offset(0, 0).Value - Value(rColl, Cell.Offset(0, 0).Address)
Else
   tsk_delay = 0
End If

Mark

Answer 10

Let's first see how to detect and save the value of a single cell of interest. Suppose Worksheets(1).Range("B1") is your cell of interest. In a normal module, use this:

Option Explicit

Public StorageArray(0 to 1) As Variant 
    ' Declare a module-level variable, which will not lose its scope as 
      ' long as the codes are running, thus performing as a storage place.
    ' This is a one-dimensional array. 
      ' The first element stores the "old value", and 
      ' the second element stores the "new value"

Sub SaveToStorageArray()
' ACTION
    StorageArray(0) = StorageArray(1)
        ' Transfer the previous new value to the "old value"

    StorageArray(1) = Worksheets(1).Range("B1").value 
        ' Store the latest new value in Range("B1") to the "new value"

' OUTPUT DEMONSTRATION (Optional)
    ' Results are presented in the Immediate Window.
    Debug.Print "Old value:" & vbTab & StorageArray(0)
    Debug.Print "New value:" & vbTab & StorageArray(1) & vbCrLf

End Sub

Then in the module of Worksheets(1):

Option Explicit

Private HasBeenActivatedBefore as Boolean
    ' Boolean variables have the default value of False.
    ' This is a module-level variable, which will not lose its scope as 
      ' long as the codes are running.

Private Sub Worksheet_Activate()        
    If HasBeenActivatedBefore = False then
        ' If the Worksheet has not been activated before, initialize the
          ' StorageArray as follows.

        StorageArray(1) = Me.Range("B1")
            ' When the Worksheets(1) is activated, store the current value
              ' of Range("B1") to the "new value", before the 
              ' Worksheet_Change event occurs.

        HasBeenActivatedBefore = True
            ' Set this parameter to True, so that the contents
              ' of this if block won't be evaluated again. Therefore, 
              ' the initialization process above will only be executed 
              ' once.
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B1")) Is Nothing then
        Call SaveToStorageArray
            ' Only perform the transfer of old and new values when 
              ' the cell of interest is being changed.
    End If
End Sub

This will capture the change of the Worksheets(1).Range("B1") , whether the change is due to the user actively selecting that cell on the Worksheet and changing the value, or due to other VBA codes that change the value of Worksheets(1).Range("B1") .

Since we have declared the variable StorageArray as public, you can reference its latest value in other modules in the same VBA project.

To expand our scope to the detection and saving the values of multiple cells of interest, you need to:

• Declare the StorageArray as a two-dimensional array, with the number of rows equal to the number of cells you are monitoring.
• Modify the Sub SaveToStorageArray procedure to a more general Sub SaveToStorageArray(TargetSingleCell as Range) and change the relevant codes.
• Modify the Private Sub Worksheet_Change procedure to accommodate the monitoring of those multiple cells.

Appendix: For more information on the lifetime of variables, please refer to: https://msdn.microsoft.com/en-us/library/office/gg278427.aspx

Answer 11

In response to Matt Roy answer, I found this option a great response, although I couldn't post as such with my current rating. :(

However, while taking the opportunity to post my thoughts on his response, I thought I would take the opportunity to include a small modification. Just compare code to see.

So thanks to Matt Roy for bringing this code to our attention, and Chris.R for posting original code.

Dim OldValues As New Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'>> Prevent user from multiple selection before any changes:

 If Selection.Cells.Count > 1 Then
        MsgBox "Sorry, multiple selections are not allowed.", vbCritical
        ActiveCell.Select
        Exit Sub
    End If
 'Copy old values
    Set OldValues = Nothing
    Dim c As Range
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

 On Local Error Resume Next  ' To avoid error if the old value of the cell address you're looking for has not been copied

Dim c As Range

    For Each c In Target
        If OldValues(c.Address) <> "" And c.Value <> "" Then 'both Oldvalue and NewValue are Not Empty
                    Debug.Print "New value of " & c.Address & " is " & c.Value & "; old value was " & OldValues(c.Address)
        ElseIf OldValues(c.Address) = "" And c.Value = "" Then 'both Oldvalue and NewValue are  Empty
                    Debug.Print "New value of " & c.Address & " is Empty " & c.Value & "; old value is Empty" & OldValues(c.Address)

        ElseIf OldValues(c.Address) <> "" And c.Value = "" Then 'Oldvalue is Empty and NewValue is Not Empty
                    Debug.Print "New value of " & c.Address & " is Empty" & c.Value & "; old value was " & OldValues(c.Address)
        ElseIf OldValues(c.Address) = "" And c.Value <> "" Then 'Oldvalue is Not Empty and NewValue is Empty
                    Debug.Print "New value of " & c.Address & " is " & c.Value & "; old value is Empty" & OldValues(c.Address)
        End If
    Next c

    'Copy old values (in case you made any changes in previous lines of code)
    Set OldValues = Nothing
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c

Answer 12

I needed this feature and I did not like all the solutions above after trying most as they are either

1. Slow
2. Have complex implications like using application.undo.
3. Do not capture if they were not selected
4. Do not captures values if they were not changed before
5. Too complex

Well I thought very hard about it and I completed a solution for a full UNDO,REDO history.

To capture the old value it is actually very easy and very fast.

My solution is to capture all values once the user open the sheet is open into a variable and it gets updated after each change. this variable will be used to check the old value of the cell. In the solutions above all of them used for loop. Actually there is way easier method.

To capture all the values I used this simple command

SheetStore = sh.UsedRange.Formula

Yeah, just that, Actually excel will return an array if the range is a multiple cells so we do not need to use FOR EACH command and it is very fast

The following sub is the full code which should be called in Workbook_SheetActivate. Another sub should be created to capture the changes. Like, I have a sub called "catchChanges" that runs on Workbook_SheetChange. It will capture the changes then save them on another a change history sheet. then runs UpdateCache to update the cache with the new values

' should be added at the top of the module
Private SheetStore() As Variant 
Private SheetStoreName As String  ' I use this variable to make sure that the changes I captures are in the same active sheet to prevent overwrite

Sub UpdateCache(sh As Object)
      If sh.Name = ActiveSheet.Name Then ' update values only if the changed values are in the activesheet
          SheetStoreName = sh.Name
          ReDim SheetStore(1 To sh.UsedRange.Rows.count, 1 To sh.UsedRange.Columns.count) ' update the dimension of the array to match used range
          SheetStore = sh.UsedRange.Formula
      End If
End Sub

now to get the old value it is very easy as the array have the same address of cells

examples if we want cell D12 we can use the following

SheetStore(row_number,column_number)
'example
return = SheetStore(12,4)
' or the following showing how I used it. 
set cell = activecell ' the cell that we want to find the old value for
newValue = cell.value ' you can ignore this line, it is just a demonstration
oldValue = SheetStore(cell.Row, cell.Column)

these are snippet explaining the method, I hope everyone like it

Answer 13

I have the same problem like you and luckily I have read the solution from this link: http://access-excel.tips/value-before-worksheet-change/

Dim oldValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    oldValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    'do something with oldValue...
End Sub

Note: you must place oldValue variable as a global variable so all subclasses can use it.

Answer 14

I've expanded a bit on Matt Roy's solution which is awesome by the way. What I did is handle situations when the user selects the whole row/column, so the macro only record the intersection between selection and ".UsedRange", and also handled situations where selection is not a range (for buttons, shapes, pivot tables)

Sub trackChanges_loadOldValues_toCollection(ByVal Target As Range)
    'LOADS SELECTION AND VALUES INTO THE COLLECTION collOldValues
    If isErrorHandlingOff = False Then: On Error GoTo endWithError
    
    Dim RngI As Range, newTarget As Range, arrValues, arrFormulas, arrAddress
    
    'DON'T RECORD WHEN SELECTING BUTTONS OR SHAPES, ONLY FOR RANGES
    If TypeName(Target) <> "Range" Then: Exit Sub
    
    'RESET OLD VALUES COLLECITON
    Set collOldValues = Nothing
    
    'ONLY RECORD CELLS IN USED RANGE, TO AVOID ISSUES WHEN SELECTING WHOLE ROW
    Set newTarget = Intersect(Target, Target.Parent.UsedRange)
    
    'newTarget.Select
    If Not newTarget Is Nothing Then
        For Each RngI In newTarget
            'ADD TO COLLECTION
            'ITEM, KEY
            collOldValues.add Array(RngI.value, RngI.formula), RngI.Address
        Next RngI
    End If
done:
        Exit Sub
endWithError:
        DisplayError Err, "trackChanges_loadOldValues_toCollection", Erl
End Sub

Answer 15

Private Sub Worksheet_Change(ByVal Target As Range)
vNEW = Target.Value
aNEW = Target.Address
Application.EnableEvents = False
Application.Undo
vOLD = Target.Value
Target.Value = vNEW
Application.EnableEvents = True
End Sub

Answer 16

Using Static will solve your problem (with some other stuff to initialize old_value properly:

Private Sub Worksheet_Change(ByVal Target As Range)
    Static old_value As String
    Dim inited as Boolean 'Used to detect first call and fill old_value
    Dim new_value As String
    If Not Intersect(cell, Range("cell_of_interest")) Is Nothing Then
         new_value = Range("cell_of_interest").Value
         If Not inited Then
             inited = True
         Else
            Call DoFoo (old_value, new_value)
        End If
        old_value = new_value
    Next cell
End Sub

In workbook code, force call of Worksheet_change to fill old_value :

Private Sub Private Sub Workbook_Open()
     SheetX.Worksheet_Change SheetX.Range("cell_of_interest")
End Sub

Note, however, that ANY solution based in VBA variables (including dictionary and another more sophisticate methods) will fail if you stop (Reset) running code (eg. while creating new macros, debugging some code, ...). To avoid such, consider using alternative storage methods (hidden worksheet, for example).

Answer 17

I have read this old post, and I would like to provide another solution.

The problem with running Application.Undo is that Woksheet_Change runs again. We have the same problem when we restore.

To avoid that, I use a piece of code to avoid the second steps through Worksheet_Change.

Before we begin, we must create a Boolean static variable BlnAlreadyBeenHere, to tell Excel not to run Worksheet_Change again

Here you can see it:

    Private Sub Worksheet_Change(ByVal Target As Range)

    Static blnAlreadyBeenHere As Boolean

    'This piece avoid to execute Worksheet_Change again
    If blnAlreadyBeenHere Then
        blnAlreadyBeenHere = False
        Exit Sub
    End If

    'Now, we will store the old and new value
    Dim vOldValue As Variant
    Dim vNewValue As Variant

    'To store new value
    vNewValue = Target.Value

    'Undo to retrieve old value

    'To avoid new Worksheet_Change execution
    blnAlreadyBeenHere = True

    Application.Undo

    'To store old value
    vOldValue = Target.Value

    'To rewrite new value

    'To avoid new Worksheet_Change execution agein
    blnAlreadyBeenHere = True
    Target.Value = vNewValue

    'Done! I've two vaules stored
    Debug.Print vOldValue, vNewValue

End Sub

The advantage of this method is that it is not necessary to run Worksheet_SelectionChange.

If we want the routine to work from another module, we just have to take the declaration of the variable blnAlreadyBeenHere out of the routine, and declare it with Dim.

Same operation with vOldValue and vNewValue, in the header of a module

Dim blnAlreadyBeenHere As Boolean
Dim vOldValue As Variant
Dim vNewValue As Variant

Answer 18

Just a thought, but Have you tried using application.undo

This will set the values back again. You can then simply read the original value. It should not be too difficult to store the new values first, so you change them back again if you like.