Private Sub Worksheet_Calculate() [closed]

Answer 1

It looks like you want to build something similar to a trading platform to highlight cells linked with RTD formulas. If it is true (or even if you make changes manually), you can achieve your goal by using worksheet_change.

The below procedure looks at cells in columns 12 to 15 (the real-time values that change) and it compares the values in the FmlaRng (which I assume is a fixed range) before the calculate occurs and after. It is important you set your sheet as xlCalculateManual otherwise Excel will calculate the new values before you can record the old ones.

Also, I am not sure if you need to keep the Application.EnableEvents, but I left it there.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim endrow As Long, startrow As Long, i As Long, j As Long
Dim PreValue As Variant
Dim FmlaRng As Range

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Column >= 12 And Target.Column <= 15 Then 'This is where the cell initally changes (the lookupvalue cells)
    On Error GoTo 0
    startrow = 1
    endrow = 1000
    With Workbooks("Workbook2").sheets("Sheet1") 'You need to change these names
    Set FmlaRng = .Range(.Cells(startrow, 94), .Cells(endrow, 100)) 'FmlaRng is where the lookups should be
    FmlaRng.Cells.Interior.ColorIndex = 0
    PreValue = FmlaRng
    Calculate 'This is when vlookups update
    For i = LBound(PreValue, 1) To UBound(PreValue, 1)
        For j = LBound(PreValue, 2) To UBound(PreValue, 2)
            If FmlaRng.Cells(i, j) = PreValue(i, j) Then
            Else
                FmlaRng.Cells(i, j).Interior.ColorIndex = 36
            End If
        Next j
    Next i
    End with
End If
Application.EnableEvents = True
End Sub

Answer 2

UPDATE

Instead of highlighting the cells, do you know how to insert a comment in each cell whenever the cell value changes? I would like to comment to say, "Changed cell from 20 to 30".

Try this code (may be time consuming for big ranges with formulas):

in Code module (standart module):

Public cVals As New Dictionary

Sub populateDict()
    Dim rng As Range, c As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = Intersect(.UsedRange, .Range("CP:CV"))
        If rng Is Nothing Then Exit Sub
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With
End Sub

in ThisWorkbook module:

Private Sub Workbook_Open()
    Application.Calculation = xlCalculationManual
    Call populateDict
    Application.Calculation = xlCalculationAutomatic
End Sub

in Sheet module:

Private Sub Worksheet_Calculate()
    Dim rng As Range, c As Range
    Dim rngToColor As Range

    On Error GoTo ErrorHandler

    Application.EnableEvents = False
    'get only used part of the sheet
    Set rng = Intersect(Me.UsedRange, Me.Range("CP:CV"))
    If rng Is Nothing Then GoTo ExitHere ' if there is no formulas in CP:CV - exit from sub

    'reset color for all cells
    rng.Interior.Color = xlNone
    For Each c In rng
        'check if previous value of this cell not equal to current value
        If cVals(c.Address) <> c.Text Then
            'if so (they're not equal), remember this cell
            c.ClearComments
            c.AddComment Text:="Changed value from '" & cVals(c.Address) & "' to '" & c.Text & "'"
        End If
        'store current value of cell in dictionary (with key=cell address)
        cVals(c.Address) = c.Text
    Next c

ExitHere:
    Application.EnableEvents = True
    Exit Sub
ErrorHandler:
    Resume ExitHere
End Sub

Note that I'm uisng Dictionary object. For working with Dictionary object you should add reference to Microsoft Scripting Runtime library. Go to Tools->References and select Microsoft Scripting Runtime library: