Counting the number of times a value has changed within a cell

Question

I'm evaluating a column of cells, for example A:A, and every time a value within a cell changes (not including the initial value), I want to be able to log the change to the appropriate cell of another column, say B:B.

The following is a pair of before and after screenshots demonstrating what is required:

A2has been updated once, so B2 should show a count of 1 and A6 has been updated twice, so B6 should show 2.

A similar solution can be found here, however this only applies to one cell:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$1" Then [A2].Value = 1
End Sub

Cell values aren't connected to different sheets and can be hard coded.

Answer 1

None of the solutions in your link are both particularly good and comprehensive enough to modify, in my opinion, so I will be posting a better one.

Also your requirements are also not quite specific enough, so I've made up a few extra ones.

Assumptions:

• All the A:A cell values start off empty. (Can be trivially modified to allow non-empty initial values.)

• An edit of a cell that results in the same value is still considered a "change". This would normally also include where the cell was initially empty, but my code specifically excludes this edge case.

• The "initial" value is the value after the first "change" to the cell. (Can be trivially modified to allow the initial value to be "empty", if that is the actual requirement.)

This is the relatively simple code:

'============================================================================================
' Module     : <The appropriate sheet module>
' Version    : 1.0
' Part       : 1 of 1
' References : N/A
' Source     : https://stackoverflow.com/a/47405528/1961728
'============================================================================================
Option Explicit

Private Sub Worksheet_Change _
            ( _
                       ByVal Target As Range _
            )

  Const s_CheckColumn As String = "A:A"
  Const s_CountColumn As String = "B:B"

  If Intersect(Target, Range(s_CheckColumn)) Is Nothing Then Exit Sub

  Dim rngCell As Range
  For Each rngCell In Intersect(Target, Range(s_CheckColumn))
    With Range(s_CountColumn).Cells(rngCell.Row)
      .Value2 = IIf(.Value2 <> vbNullString, .Value2 + 1, IIf(rngCell.Value2 <> vbNullString, 0, vbNullString))
    End With
  Next rngCell

End Sub

This solution correctly allows for multiple cells to be edited simultaneous, as happens when you do a multi-cell delete/paste or a fill.

Notes:

• The initial "change" results in a count of 0. If you wish to hide these zeroes, set a custom number format of #;; for the count column.

• The code can be modified to stop a "same value" edit from counting as a "change". One of the simplest ways of doing this is to use an extra column to store the old values.

Caveats:

• Undo will no longer work correctly. This can be rectified, but it is not trivial to do so.

• Pressing an ESC after starting an edit is required to cancel the edit and not trigger an update.