I have the following code in my worksheet_calculate sub, and another sub:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ActiveSheet.Unprotect Password:="letsplaydarts"
Dim myRange As Range
Dim r2 As Range
Dim vNewValue As Variant
Dim vOldValue As Variant
Dim i As Integer
Dim iError As Long
Dim sAddress As String
'Define the range
Set myRange = Range(sGblSheet1RANGE)
'If a runtime error is generated because the old value array was not defined
'then generate the old value array
On Error Resume Next
vOldValue = vGblSheet1CalculatedOldValues(1)
iError = Err.Number
If iError = 9 Then
Call InitialzeSheet1SavedValuesForWorksheetCalculate
End If
On Error GoTo 0
'Examine each value in the range
For Each r2 In myRange
i = i + 1
vOldValue = vGblSheet1CalculatedOldValues(i)
vNewValue = r2.Value
'If the value in a cell was changed:
'a. Output a message
'b. Save the 'new value' as the 'old value'
If vNewValue <> vOldValue Then
sAddress = r2.Address(False, False) 'Get the address without the Dollar Signs '$'
MsgBox "The value of cell '" & sAddress & "' was changed by FORMULA " & _
"from '" & vOldValue & "' to '" & vNewValue & "'.", , "Worksheet_Calculate()"
vGblSheet1CalculatedOldValues(i) = vNewValue
End If
Next r2
'Clear the range object
Set myRange = Nothing
Option Explicit
'The following 'Global Variable' saves the 'Old' value of Cell 'AC6' 'Worksheet_Change()'
Public vGblSheet1OldA1Value As Variant
'The following defines the range that will be examined in 'Worksheet_Calculate()'
Public Const sGblSheet1RANGE = "AC6"
'The following is the array that contains the 'old values' for the range that will be examined in 'Worksheet_Calculate()'
Public vGblSheet1CalculatedOldValues() As Variant
Sub InitialzeSheet1SavedValuesForWorksheetCalculate()
Dim myRange As Range
Dim r As Range
Dim i As Integer
Dim iItemsInRange As Integer
'Define the range
Set myRange = Range(sGblSheet1RANGE)
'Redimension the dynamic array to hold the number of items in the range
'Save the original values in the range
iItemsInRange = myRange.Count
If iItemsInRange > 0 Then
ReDim vGblSheet1CalculatedOldValues(1 To iItemsInRange)
End If
For Each r In myRange
i = i + 1
vGblSheet1CalculatedOldValues(i) = r.Value
Next r
'Clear the range object
Set myRange = Nothing
End Sub
it's a bit of a complicated sheet here checkboxes are ticked, and when 3 in a certain area are ticked, then a cell value changes (AC6)
This works very well, and the message is displayed.
Any ideas how I would adapt this to include other cells? The cells I'd want to include are AC6, AC9, AC12, AC15, AC18, AC21, AC24.
Thanks in advance
Bookmarks