Detect whether cell value was actually changed by editing

I suggest automatically maintaining a "mirror copy" of your sheet, in another sheet, for comparison with the changed cell's value.

@brettdj and @JohnLBevan essentially propose doing the same thing, but they store cell values in comments or a dictionary, respectively (and +1 for those ideas indeed). My feeling, though, is that it is conceptually much simpler to back up cells in cells, rather than in other objects (especially comments, which you or the user may want to use for other purposes).

So, say I have Sheet1 whose cells the user may change. I created this other sheet called Sheet1_Mirror (which you could create at Workbook_Open and could set to be hidden if you so desire -- up to you). To start with, the contents of Sheet1_Mirror would be identical to that of Sheet1 (again, you could enforce this at Workbook_Open).

Every time Sheet1's Worksheet_Change is triggered, the code checks whether the "changed" cell's value in Sheet1 is actually different from that in Sheet1_Mirror. If so, it does the action you want and updates the mirror sheet. If not, then nothing.

This should put you on the right track:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    For Each r In Target.Cells
        'Has the value actually changed?
        If r.Value <> Sheet1_Mirror.Range(r.Address).Value Then
            'Yes it has. Do whatever needs to be done.
            MsgBox "Value of cell " & r.Address & " was changed. " & vbCrLf _
                & "Was: " & vbTab & Sheet1_Mirror.Range(r.Address).Value & vbCrLf _
                & "Is now: " & vbTab & r.Value
            'Mirror this new value.
            Sheet1_Mirror.Range(r.Address).Value = r.Value
        Else
            'It hasn't really changed. Do nothing.
        End If
    Next
End Sub

This code uses Comments to store the prior value (Please note if you do need the comments for other purposes this method will remove them)

  1. Cells that have no value have colour reset to xlNone
  2. An intial value typed into a cell is blue (ColorIndex 34)
  3. If the value is changed the cell goes from blue to yellow

enter image description here

Normal module - turn display of comments off

    Sub SetCom()
      Application.DisplayCommentIndicator = xlNoIndicator
    End Sub

Sheet code to capture changes

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng1 As Range
    Dim shCmt As Comment
    For Each rng1 In Target.Cells

    If Len(rng1.Value) = 0 Then
    rng1.Interior.ColorIndex = xlNone
    On Error Resume Next
    rng1.Comment.Delete
    On Error GoTo 0
    Else

    On Error Resume Next
    Set shCmt = rng1.Comment
    On Error GoTo 0

    If shCmt Is Nothing Then
        Set shCmt = rng1.AddComment
        shCmt.Text Text:=CStr(rng1.Value)
         rng1.Interior.ColorIndex = 34
    Else
        If shCmt.Text <> rng1.Value Then
            rng1.Interior.ColorIndex = 36
            shCmt.Text Text:=CStr(rng1.Value)
        End If
    End If
    End If
    Next
    End Sub

Try this code. When you enter a range it stores the original cell values in a dictionary object. When the worksheet change is triggered it compares the stored values with the actuals and highlights any changes.
NB: to improve efficiency reference microsoft scripting runtime & replace the As Object with As Scripting.Dictionary and the CreateObject("Scripting.Dictionary") with New Scripting.Dictionary.

Option Explicit

Private previousRange As Object 'reference microsoft scripting runtime & use scripting.dictionary for better performance
                                'I've gone with late binding to avoid references from confusing the example


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Variant

    For Each cell In Target
        If previousRange.Exists(cell.Address) Then
            If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
                cell.Interior.ColorIndex = 36
            End If
        End If
    Next

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim cell As Variant

    Set previousRange = Nothing 'not really needed but I like to kill off old references
    Set previousRange = CreateObject("Scripting.Dictionary")

    For Each cell In Target.Cells
        previousRange.Add cell.Address, cell.FormulaR1C1
    Next

End Sub

ps. any vba code to update cells (even just colour) will stop excel's undo functionality from working! To get around this you can reprogram undo functionality, but it can get quite memory intensive. Sample solutions: http://www.jkp-ads.com/Articles/UndoWithVBA00.asp / http://www.j-walk.com/ss/excel/tips/tip23.htm

Tags:

Excel

Vba