You could keep the values of the sheet in memory, and upon each recalculation check which have changed while at the same time updating that array.
Here is some code, to place in the ThisWorkbook
module, that would have such a detection set up for the first sheet (change Sheet1
to whichever sheet you want to monitor):
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
Debug.Print cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub
You could use some If
statement(s) in the last routine to filter out only those ranges you are really interested in.
For All Sheets
If you need to monitor changes in multiple sheets, you could build your cache to be a collection of 2D arrays, one collection entry per sheet, keyed by its name.
Dim cache As Collection
Private Sub Workbook_Open()
Dim sheet As Worksheet
Set cache = New Collection
' Initialise the cache when the workbook opens
For Each sheet In ActiveWorkbook.Sheets
cache.Add getSheetValues(sheet), sheet.CodeName
Next
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
' Get the values of the sheet and from the cache
previous = cache(Sh.CodeName)
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.Remove Sh.CodeName
cache.Add current, Sh.CodeName
ext:
End Sub
Private Sub CellChanged(cell As Range, oldValue As Variant)
' This is the place where you would put your logic
Debug.Print cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub
This would work for sheets that exist from the start, not sheets that are added.
Of course, that also could be made to work, but you'll get the idea.