Cell Flashing VBA code check

[naseeb]

Hello,

below code flashes cell when value changes, it saves value of original cell b and save its and compares,
however when the value of cell is based on another cell or based on a formuae, then this code doesnt work, please help

PrivateSub Worksheet_Change(ByVal Target As Range)Dim KeyCells As Range
Set KeyCells = Range("B1:B27")

IfNot Application.Intersect(KeyCells, Range(Target.Address)) _IsNothingThenIf Target.Value > Cells(Target.Row,5).Value Then'flash green
Target.Interior.ColorIndex =10
Pause 0.5
Target.Interior.ColorIndex =2
Pause 0.5
Target.Interior.ColorIndex =10ElseIf Target.Value < Cells(Target.Row,5).Value Then'flash red
Target.Interior.ColorIndex =3
Pause 0.5
Target.Interior.ColorIndex =2
Pause 0.5
Target.Interior.ColorIndex =3EndIf
Cells(Target.Row,5).Value = Target.Value
EndIfEndSub

'Pauses execution without holding up main UI threadPublicFunction Pause(NumberOfSeconds AsVariant)OnErrorGoTo Error_GoToDim PauseTime AsVariantDim Start AsVariant

PauseTime = NumberOfSeconds
Start = Timer
DoWhile Timer < Start + PauseTime
DoEvents
Loop

Exit_GoTo:OnErrorGoTo0ExitFunction
Error_GoTo:
Debug.Print Err.Number, Err.Description, Erl
GoTo Exit_GoToEndFunction

 

[Marc L]

Hi !

This event can work only after a manual input …
​

 

[naseeb]

thanks Marc, but there should be a way,

 

[Marc L]

As flashing does not exist within Excel as well a formula_change event …
​

 

[vletm]

@naseeb
You could modify this for Your purpose...
or
You should set sample file here.

 

[shrivallabha]

Try to use Sheet_Calculate event and see if it helps. In the sheet module where your Worksheet_change event is place this code:

Private Sub Worksheet_Calculate()
Dim KeyCells As Range, rngTarget As Range
Set KeyCells = Range("B1:B27")

If Not Application.Intersect(Cells.SpecialCells(xlCellTypeFormulas), KeyCells) _
      Is Nothing Then
    For Each rngTarget In Application.Intersect(Cells.SpecialCells(xlCellTypeFormulas), KeyCells)
    If rngTarget.Value > Cells(rngTarget.Row, 5).Value Then
        'flash green
        rngTarget.Interior.ColorIndex = 10
        Pause 0.5
        rngTarget.Interior.ColorIndex = 2
        Pause 0.5
        rngTarget.Interior.ColorIndex = 10
    ElseIf rngTarget.Value < Cells(rngTarget.Row, 5).Value Then
        'flash red
        rngTarget.Interior.ColorIndex = 3
        Pause 0.5
        rngTarget.Interior.ColorIndex = 2
        Pause 0.5
        rngTarget.Interior.ColorIndex = 3
    End If
    Cells(rngTarget.Row, 5).Value = rngTarget.Value
    Next rngTarget
End If

End Sub

 

[naseeb]

Hello shrivallabha,

thanks indeed, this is what i wanted,
like your work, good

 

[Marc L]

Well done shrivallabha !
​

 

[shrivallabha]

Well done shrivallabha !
​

Thank you Marc