VB code for conditional formatting on live value cell?

[slimimi]

Hi there,\

Sorry for my long Title description - hope i got it right !!

Is there a way to look at a cell's own value and then format it accordingly using VB?

eg,

I have a cell whose value changes based on DDE link to live price data.
Cell is "Q5".

When the new value is greater than the old value - i want to format the pattern color of the cell.

When the new value is less than the old value - i want to format the pattern color of the cell.

Does anyone know how to do this please or is there a way to do this using spreadsheet formulas as oppose to VB?

THanks in advance for looking in..

 

[GlennUK]

How are you going to compare to the old value exactly?

 

[slimimi]

i am not quite sure how to do it.
How about something in Selection Change by val possible?

 

[Legacy 98055]

Well... Using conditional formatting just adds complication because the condition is going to change. You would be better off to just set the format straight away. The only problem here is how you are going to watch your cell. There are a handful of ways to do this. SetLinkOnData is one. Using a hidden sheet with a function that refers to your updated cell and then capturing the change in the calculate event is another. My favorite is to use a textbox, set it's controlsource or linkedcell property to the address of the cell being updated and then using one or more of the textbox's inherent events. In VB, you can place the DDE link right in the properties window. I have not tried this in MSForms.

 

[slimimi]

Ok tom - sounds very interesting. Would you be able to show me how to go about doing this please (possibly) the textbox option. I wouldnt know where to start (with the code).

 

[Legacy 98055]

Ok. Here is a basic example that may do well enough for you.

Assuming that your DDE link is located in Q5 on Sheet1. Add TextBox1. Set its linkedcell property to Q5, set its visible property to false. Paste this code into the same worksheet.

The nice thing about using a textbox is that it does not care how the cell is changed. It will always fire the change event once per change. Using the calculate event can get messy. SetLinkOnData works sometimes. If you have many values, a timer works well.

If the value in Q5 goes lower, the cell will turn blue. If higher, red. If the value does not change, the color does not change.

<a href="http://home.fuse.net/tstom/0704082348.328222.zip"><img src="http://home.fuse.net/tstom/zip.gif"width="48"height="48"border="0"></a> <a href="http://home.fuse.net/tstom/0704082348.328222.zip">0704082348.328222.zip</a>

Option Explicit

Private OldValue

Private Sub TextBox1_Change()
    Dim NewValue
    
    NewValue = TextBox1.Value
    
    If NewValue > OldValue Then
        Range("Q5").Interior.Color = vbRed
    ElseIf NewValue < OldValue Then
        Range("Q5").Interior.Color = vbBlue
    Else
        'do nothing - the values are the same
    End If
    
    OldValue = NewValue
End Sub

Private Sub Worksheet_Activate()
    OldValue = Range("Q5").Value
End Sub

Paste this code into the workbook class.

Private Sub Workbook_Open()
    Application.Run Sheets("Sheet1").CodeName & ".Worksheet_Activate"
End Sub

 

[slimimi]

This looks great thank you very much. I am not quite sure, however, what i should use the text box for. Do you mean i should put the formula =MT4|BID!EURUSDm into the textbox? Sorry for sounding silly. I would love to send you a screenshot of my spreadsheet so that you can see the layout if thats ok with you. Could you advise me how to send this to you?

Ok i have a direct download link that you can grab the screenshot from.
It:

http://www.4shared.com/file/53971519/636d373f/Positions_Calc.html

THanks a million in advance...

 

[slimimi]

Hi Tom. How exactly did you add the textbox to the example worksheet you sent me?

I cant figure it out

Also - i have different currency live feeds in Cells S5, S8, S11, S14, S17, S20 and S23
My sheet is named "positions"

What would i have to change on your code (in the range) to get it to look at these cells and also to look at the sheet "positions" instead? and lastly (sorry) how do i create the textbox and would i have to create a textbox for each of the 7 live cell feeds?

Thanks in advance

 

[Legacy 98055]

Place this is the workbook class:

Option Explicit

Private LinkRanges(6) As Range
Private PreviousLinkRangeValues(6) As Currency

Private Sub Workbook_Open()
    StartWatchingLinks
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopWatchingLinks
End Sub

Friend Sub StartWatchingLinks()
    Dim x As Integer
    
    On Error Resume Next
    For x = 0 To 6
        With Me.Worksheets("positions")
            Set LinkRanges(x) = .Range(Choose(x + 1, "S5", "S8", "S11", "S14", "S17", "S20", "S23"))
            PreviousLinkRangeValues(x) = LinkRanges(x).Value
        End With
    Next
    
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem00", "'ThisWorkbook.OnLinkUpdate ""0""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem01", "'ThisWorkbook.OnLinkUpdate ""1""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem02", "'ThisWorkbook.OnLinkUpdate ""2""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem03", "'ThisWorkbook.OnLinkUpdate ""3""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem04", "'ThisWorkbook.OnLinkUpdate ""4""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem05", "'ThisWorkbook.OnLinkUpdate ""5""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem06", "'ThisWorkbook.OnLinkUpdate ""6""'"
End Sub

Friend Sub StopWatchingLinks()
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem00", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem01", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem02", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem03", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem04", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem05", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem06", ""
End Sub

Friend Sub OnLinkUpdate(LinkIndex As Integer)
    If LinkRanges(LinkIndex).Value > PreviousLinkRangeValues(LinkIndex) Then
         LinkRanges(LinkIndex).Interior.Color = vbRed
    ElseIf LinkRanges(LinkIndex).Value < PreviousLinkRangeValues(LinkIndex) Then
        LinkRanges(LinkIndex).Interior.Color = vbBlue
    End If
    PreviousLinkRangeValues(LinkIndex) = LinkRanges(LinkIndex).Value
End Sub

Of course you will need to replace the link names.
Replace DDEServerExe|DDETopic!LinkItem00 with the link name you have in S5.
Replace DDEServerExe|DDETopic!LinkItem01 with the link name you have in S8
.
and so on...

The example contains a workbook and DDEServerExe.exe. DDEServerExe.exe just throws some random numbers to Excel. It's a simple, handy tool to test DDE links in Excel. Extract both files. Open the workbook and run the server. The server will work with the links/code above...

<a href="http://home.fuse.net/tstom/0706080200.328222.zip"><img src="http://home.fuse.net/tstom/zip.gif"width="48"height="48"border="0"></a> <a href="http://home.fuse.net/tstom/0706080200.328222.zip">0706080200.328222.zip</a>

 

[Legacy 98055]

Add minimum error handling. Download example in previous post is updated.

Option Explicit

Private LinkRanges(6) As Range
Private PreviousLinkRangeValues(6) As Currency

Private Sub Workbook_Open()
    StartWatchingLinks
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopWatchingLinks
End Sub

Friend Sub StartWatchingLinks()
    Dim x As Integer
    
    On Error Resume Next
    For x = 0 To 6
        With Me.Worksheets("positions")
            Set LinkRanges(x) = .Range(Choose(x + 1, "S5", "S8", "S11", "S14", "S17", "S20", "S23"))
            PreviousLinkRangeValues(x) = LinkRanges(x).Value
        End With
    Next
    
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem00", "'ThisWorkbook.OnLinkUpdate ""0""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem01", "'ThisWorkbook.OnLinkUpdate ""1""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem02", "'ThisWorkbook.OnLinkUpdate ""2""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem03", "'ThisWorkbook.OnLinkUpdate ""3""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem04", "'ThisWorkbook.OnLinkUpdate ""4""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem05", "'ThisWorkbook.OnLinkUpdate ""5""'"
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem06", "'ThisWorkbook.OnLinkUpdate ""6""'"
End Sub

Friend Sub StopWatchingLinks()
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem00", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem01", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem02", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem03", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem04", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem05", ""
    ThisWorkbook.SetLinkOnData "DDEServerExe|DDETopic!LinkItem06", ""
End Sub

Friend Sub OnLinkUpdate(LinkIndex As Integer)
    On Error GoTo ErrOnLinkUpdate
    If LinkRanges(LinkIndex).Value > PreviousLinkRangeValues(LinkIndex) Then
         LinkRanges(LinkIndex).Interior.Color = vbRed
    ElseIf LinkRanges(LinkIndex).Value < PreviousLinkRangeValues(LinkIndex) Then
        LinkRanges(LinkIndex).Interior.Color = vbBlue
    End If
    PreviousLinkRangeValues(LinkIndex) = LinkRanges(LinkIndex).Value
ErrOnLinkUpdate:
End Sub