Everytime a cell changes in a range, record the old value as a comment

backgroundbook · Feb 18th 2020

Everytime a cell changes in a named range, I want the code to clear existing comments, then record the old value as a new comment. I have to use Worksheet_Calculate because the cell changes based on a formula. I have tried several, methods, but none are working...

Code

Private Sub Worksheet_Calculate()
Dim Target As Range
Dim c As Range
If Not Target Is Nothing Then Exit Sub
For Each c In Range("Colonne8300")
If c.Count > 1 Then Exit Sub
c.ClearComments
c.AddComment.Text Text:="TEST"
Next
End Sub

Display More

In this case, it adds a comment to every cell.

Code

Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Auparavant " & preValue & Chr(10) & "Actuellement " _
& Format(Date, "mm-dd-yyyy") & Chr(10) & "Modification par " & Environ("UserName")
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub

Display More

This works only when I change the cell manually.

backgroundbook · Feb 18th 2020

I have found a part solution (placed in the ThisWorkbook module):

Code

Dim cache As Variant
Private Sub Workbook_Open()
cache = getSheetValues(Sheet1)
End Sub
Private Function getSheetValues(sheet As Worksheet) As Variant
Dim arr As Variant
Dim cell As Range
' Get last cell in the used range
Set cell = sheet.Cells.SpecialCells(xlCellTypeLastCell)
' Get all values in the range between A1 and that cell
arr = sheet.Cells.Resize(cell.Row, cell.Column)
If IsEmpty(arr) Then ReDim arr(0, 0) ' Default if no data at all
getSheetValues = arr
End Function
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim current As Variant
Dim previous As Variant
Dim i As Long
Dim j As Long
Dim prevVal As Variant
Dim currVal As Variant
If Sh.CodeName <> Sheet1.CodeName Then Exit Sub
' Get the values of the sheet and from the cache
previous = cache
current = getSheetValues(Sh)
For i = 1 To WorksheetFunction.Max(UBound(previous), UBound(current))
For j = 1 To WorksheetFunction.Max(UBound(previous, 2), UBound(current, 2))
prevVal = ""
currVal = ""
On Error Resume Next ' Ignore errors when out of array bounds
prevVal = previous(i, j)
currVal = current(i, j)
On Error GoTo 0
If prevVal <> currVal Then
' Change detected: call the function that will treat this
CellChanged Sheet1.Cells(i, j), prevVal
End If
Next
Next
' Update cache
cache = current
ext:
End Sub
Private Sub CellChanged(cell As Range, oldValue As Variant)
' This is the place where you would put your logic
MsgBox cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub

Display More

However, I would want this to only look in 3 named ranges instead of the whole sheet, and to add a comment inside the changed cell instead of a message box, something like this:

Code

Target.ClearComments
Target.AddComment.Text Text:= preValue & Chr(10) &
Format(Date, "mm-dd-yyyy") & Environ("UserName")

Everytime a cell changes in a range, record the old value as a comment

Share

Tags