CODEWITHSUNDEEP
excelvba
Mehdi LAMRANI
Mehdi LAMRANI

Reputation: 11607

Excel : Alternatively Change Cell Color as Cell Value Changes

I have developed an Excel Real-Time Data Feed (RTD) to monitor Stock Prices as they arrive.
I Would like to find a way to change the color of a cell as prices change.

For example, a cell initially Green would turn to Red when the value changes (new price occurred on it via RTD Formula it contains) and then change back to Green when a new price arrives, and so on...

Upvotes: 0

Views: 13796

Answers (6)

orducom1
orducom1

Reputation: 1

Alternatively, the most simple is this code :

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.ColorIndex = 6 ': yellow
End Sub

Upvotes: 0

Pranav Singh
Pranav Singh

Reputation: 20181

I was looking for same. My scenario was like change the color of cell when value is select from list. Each list item corresponds for a color.

What eventually worked for me is:

Private Sub Worksheet_Change(ByVal Target As Range)

    Set MyPlage = Range("B2:M50")

    For Each Cell In MyPlage

        Select Case Cell.Value

         Case Is = "Applicable-Incorporated"

            Cell.Font.Color = RGB(0, 128, 0)
        Case Is = "Applicable/Not Incorporated"
            Cell.Font.Color = RGB(255, 204, 0)

        Case Is = "Not Applicable"
            Cell.Font.Color = RGB(0, 128, 0)

        Case Else
            Cell.EntireRow.Interior.ColorIndex = xlNone

        End Select

    Next

    ActiveWorkbook.Save

End Sub

Upvotes: 0

Benjamin
Benjamin

Reputation: 11

Sub Worksheet_Change(ByVal ChangedCell As Range)

  ' This routine is called whenever the user changes a cell.
  ' It is not called if a cell is changed by Calculate.

  Dim ColChanged As Integer
  Dim RowChanged As Integer

  ColChanged = ChangedCell.Column
  RowChanged = ChangedCell.Row

  With ActiveSheet
    If .Cells(RowChanged, ColChanged).Interior.ColorIndex = 19 Then
      ' Changed cell is red.  Set it to green.
      .Cells(RowChanged, ColChanged).Interior.ColorIndex = 19
    Else
      ' Changed cell is not red.  Set it to red.
      .Cells(RowChanged, ColChanged).Interior.ColorIndex = 19
    End If
  End With

End Sub

Upvotes: 1

Tony Dallimore
Tony Dallimore

Reputation: 12413

Both the previous answer assume that Real-time data feed triggers worksheet events. I can find nothing in the RTD documents to confirm or deny this assumption. However, if it does trigger worksheet events, I would have thought that Worksheet_Change would have been the most useful since it identifies a cell that has changed.

The following might be worth trying. It must be placed in the code area for the relevant worksheet.

Option Explicit
Sub Worksheet_Change(ByVal ChangedCell As Range)

  ' This routine is called whenever the user changes a cell.
  ' It is not called if a cell is changed by Calculate.

  Dim ColChanged As Integer
  Dim RowChanged As Integer

  ColChanged = ChangedCell.Column
  RowChanged = ChangedCell.Row

  With ActiveSheet  
    If .Cells(RowChanged, ColChanged).Font.Color = RGB(255, 0, 0) then 
      ' Changed cell is red.  Set it to green.
      .Cells(RowChanged, ColChanged).Font.Color = RGB(0, 255, 0)
    Else
      ' Changed cell is not red.  Set it to red.
      .Cells(RowChanged, ColChanged).Font.Color = RGB(255, 0, 0)
    End If
  End With

End Sub

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53136

This solution reposonds to a Calculation event. I am not entirely sure if an RTD update triggers this, so you will need to experiment.

Add this code to the Worksheet module containing your RTD calls.

It keeps a copy of the sheet data in memory from the last calculation, and on each calc compares new values.
It limits its action to cells containing your formula.

Option Explicit

Dim vData As Variant
Dim vForm As Variant

Private Sub Worksheet_Calculate()
    Dim vNewData As Variant
    Dim vNewForm As Variant
    Dim i As Long, j As Long

    If IsArray(vData) Then
        vNewData = Me.UsedRange
        vNewForm = Me.UsedRange.Formula
        For i = LBound(vData, 1) To UBound(vData, 1)
        For j = LBound(vData, 2) To UBound(vData, 2)
            ' Change this to match your RTD function name
            If vForm(i, j) Like "=YourRTDFunction(*" Then  
                If vData(i, j) <> vNewData(i, j) Then
                    With Me.Cells(i, j).Interior
                        If .ColorIndex = 3 Then
                            .ColorIndex = 4
                        Else
                            .ColorIndex = 3
                        End If
                    End With
                End If
            End If
        Next j, i
    End If
    vData = Me.UsedRange
    vForm = Me.UsedRange.Formula

End Sub

Upvotes: 0

Arnoud Kooi
Arnoud Kooi

Reputation: 1767

Maybe this can get you started? I supose a event is raised when the real time data is refreshed. the concept sis to store the real time data in a variabele and check if it has changed

 Dim rtd As String

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With ActiveSheet.Range("A1")
        If .Value <> rtd Then
            Select Case .Interior.ColorIndex
                Case 2
                    .Interior.ColorIndex = 3
                Case 3
                    .Interior.ColorIndex = 4
                Case 4
                    .Interior.ColorIndex = 3
                Case Else
                    .Interior.ColorIndex = 2
            End Select
        Else
            .Interior.ColorIndex = 2

        End If
        rtd = .Value
    End With

End Sub

Upvotes: 3

Related Questions