CODEWITHSUNDEEP
vbaexcelmacros
JustSomeExcelVbathings
JustSomeExcelVbathings

Reputation: 3

VBA macro to change color of cell that changes value for 1 second

I am working on Excel Project and I am dealing with prices that are changing live and are taken from external source in column E and F.

What I want is :

  1. When These cells Change value, I want them to Change its Color from orange to lets say White, or Change cell Background to White
  2. I want this to happen only for 1 second or less, and to revert back to original cell Color or Background Color

This way I can Keep my eye on prices when they Change.

Is this possible ?

Please help. thanks

Upvotes: 0

Views: 5342

Answers (1)

Harley B
Harley B

Reputation: 569

Add this into the code of the worksheet you want it to apply to (not in a seperate module) for a 1 second colour change when any cell in column E or F changes:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E:F")) Is Nothing Then
        Target.Interior.ColorIndex = 2
        Application.Wait (Now + #0:00:01#)
        Target.Interior.ColorIndex = 46
    End If
End Sub

Or for less than 1 second change, use the version below as application.wait doesn't handle times any finer than 1 second, but timer does.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E:F")) Is Nothing Then
        Dim x As Single
        x = Timer
            While Timer - x < 0.5
                Target.Interior.ColorIndex = 2
            Wend
                Target.Interior.ColorIndex = 46
    End If
End Sub

The ColorIndex values are for white and default orange. To change to the particular colors you're looking for, see http://dmcritchie.mvps.org/excel/colors.htm

EDIT - New answer below. Original answer above.

Ok, this is a bit of a messy way around it but should achieve what you're looking to do.

Paste this into a module, adjusting the 1 to 10 to cover the number of cells you're watching for changes in:

Public val(1 To 10) As Variant

Paste this into your ThisWorkbook code area, adjusting the cell references so every ref you're watching is included in the correct ascending order (Column E lowest to highest, then Column F lowest to highest):

Private Sub Workbook_Open()
    val(1) = Sheet1.Range("E1").Value
    val(2) = Sheet1.Range("E2").Value
    val(3) = Sheet1.Range("E3").Value
    val(4) = Sheet1.Range("E4").Value
    val(5) = Sheet1.Range("E5").Value
    val(6) = Sheet1.Range("F1").Value
    val(7) = Sheet1.Range("F2").Value
    val(8) = Sheet1.Range("F3").Value
    val(9) = Sheet1.Range("F4").Value
    val(10) = Sheet1.Range("F5").Value
End Sub

Finally, paste this into the code area of the sheet with the values you're watching for changes, again adjusting the ranges to fit your watch range:

Private Sub Worksheet_Calculate()
Dim x As Single, colIndx As Integer
i = 1

    For Each cell In Range("E1:E5")
        If cell.Value <> val(i) Then
            colIndx = cell.Interior.ColorIndex
            x = Timer
            While Timer - x < 0.5
                cell.Interior.ColorIndex = 2
            Wend
            cell.Interior.ColorIndex = colIndx
            val(i) = cell.Value
        End If
        i = i + 1
    Next cell

    For Each cell In Range("F1:F5")
        If cell.Value <> val(i) Then
            colIndx = cell.Interior.ColorIndex
            x = Timer
            While Timer - x < 0.5
                cell.Interior.ColorIndex = 2
            Wend
            cell.Interior.ColorIndex = colIndx
            val(i) = cell.Value
        End If
        i = i + 1
    Next cell
End Sub

Finally save and close your workbook and re-open it and hopefully the colours should update along with the values.

Upvotes: 2

Related Questions