CODEWITHSUNDEEP
excelvba
meg_orm
meg_orm

Reputation: 13

Worksheet Calculate - Font Colour Change With Cell Value Change

I have been searching for hours but struggling to find an answer.

I have a workbook with various vlookups. I have restricted one sheet to manual calculation, and I'm trying to find a macro that will then run the calculations manually and change the font colour of changed cells.

I'm currently using worksheet_calculate() function but I can't work out how to make it pick out individual cell changes post-calculation and change the font colour.

Thanks in advance!

Upvotes: 1

Views: 265

Answers (2)

Pᴇʜ
Pᴇʜ

Reputation: 57753

You need to read all values into an array before calculation so you can compare it to the values after calculation:

Option Explicit

Sub ColorChangedCellsAfterCalculation()
    Dim RangeToCheck As Range 'define which range we want to check
    Set RangeToCheck = Worksheets("Sheet1").Range("A1:C5")

    'read values BEFORE calculation into array
    Dim PreCalcValues As Variant
    PreCalcValues = RangeToCheck.Value

    'calculate
    Application.Calculate

    'read values AFTER calculation into array
    Dim PostCalcValues As Variant
    PostCalcValues = RangeToCheck.Value

    Dim ChangedData As Range 'we collect all changed cells in this variable

    'Loop through array and check which row/column values changed
    Dim iRow As Long, iCol As Long
    For iRow = 1 To RangeToCheck.Rows.Count
        For iCol = 1 To RangeToCheck.Columns.Count
            If PreCalcValues(iRow, iCol) <> PostCalcValues(iRow, iCol) Then
                If ChangedData Is Nothing Then 'collect all changed data
                    Set ChangedData = RangeToCheck(iRow, iCol) 'first changed cell
                Else
                    Set ChangedData = Union(ChangedData, RangeToCheck(iRow, iCol)) 'add all other changed cells
                End If
            End If
        Next iCol
    Next iRow

    If Not ChangedData Is Nothing Then ChangedData.Interior.Color = vbRed 'mark all changed data red
End Sub

Imagine the following data …

enter image description here

It will turn into …

enter image description here

Note that if you run that on a large data, the comparison will take a lot of time. Therefore don't run this on the whole sheet but only on your desired data range.

Upvotes: 1

EvR
EvR

Reputation: 3498

You could use application.evaluate, evaluate your formulas and check them against the current value:

    Sub tst()
    For Each cl In Sheet1.Cells.SpecialCells(xlCellTypeFormulas)
        If Application.Evaluate(cl.Formula) <> cl.Value Then
            cl.Interior.ColorIndex = 3
        Else
            cl.Interior.ColorIndex = xlNone
        End If
    Next cl
' application.calculate or sheet calculate
    End Sub

Upvotes: 0

Related Questions