VBA - Formatting TextBox (Shapes) text colour and arrow based on linked data

[shhykk]

Hi,

I have some movement data that can either be 0, >0 or <0. They are in cell C18, C19, C20. [Variable Cells]

They are linked into 3 textboxes (Insert > Shapes >Textbox). I want to be able to change the font colour in these textbook to green when the Variable Cells are >0, and red when <0, and yellow =0. It would be great if the textbook also include an arrow up/down/flat as well.

Is there a way to do it?

All these (textboxes and variable cells) sat on a worksheet called "Dashboard".

THank you.

Kind regards,
shhykk

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tbx As String
  
  'Adjust the range of cells
  If Not Intersect(Target, Range("C18:C20")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    
    'Adjust the row and its respective textbox name
    Select Case Target.Row
      Case 18: tbx = "TextBox1"
      Case 19: tbx = "TextBox2"
      Case 20: tbx = "TextBox3"
    End Select
    
    '
    With ActiveSheet.DrawingObjects(tbx).Interior
      Select Case Target.Value
        Case Is < 0: .Color = vbRed
        Case Is = 0: .Color = vbYellow
        Case Is > 0: .Color = vbGreen
      End Select
    End With
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

Modify the value in cells C18 to C20, automatically the color of the textbox will change.

 

[shhykk]

Hi Dante,

Thank you for your help. I just gave this a go. After pasting it in the "View Code" window pop up, it didnt do anything (ie no text colour changes). I have made amendments to my current worksheet as such:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbx As String

'Adjust the range of cells
If Not Intersect(Target, Range("H156:H158")) Is Nothing Then
If Target.CountLarge > 1 Then Exit Sub

'Adjust the row and its respective textbox name
Select Case Target.Row
Case 156: tbx = "TextBox 10"
Case 157: tbx = "TextBox 15"
Case 158: tbx = "TextBox 46"
End Select

'
With ActiveSheet.DrawingObjects(tbx).Interior
Select Case Target.Value
Case Is < 0: .Color = vbRed
Case Is = 0: .Color = vbYellow
Case Is > 0: .Color = vbGreen
End Select
End With
End If
End Sub

Note, the all 3 textboxes is linked to another cell to display data (inside the textbox, for example, is =$H$156)

Did I do something wrong?

Thank you in advance.

Kind regards,
shhykk

 

[DanteAmor]

Range("H156:H158")

You must capture values in those cells or you have a formula in those cells.

 

[shhykk]

There's a formula in those cells that shows a value eg $10 or -$10

i want the textbox to link to this value (in the range) and then if its +$10, the text in the textbox will be green, -$10 will be red, $0 is yellow. And the text is linked to Range("I156:I158") because I would have a small commentary like "YoY +$10" in it.

 

[DanteAmor]

I understand, if you change the value of the cell, you want to change the color of the shape.
For the color to change it must trigger an event. To trigger an event you must modify the value of a cell. A formula does not modify the value of the cell, what changes is the result of the formula.

So I must trace where the formula starts.
You can put here the 3 formulas of those cells.

Just so you understand how it works.
Delete the formulas you have in those cells.
Write the value 10 in one of the cells, write 0, now -10, you will see how the color changes

 

[shhykk]

Arr... thank you, you have explained this really well! Now I understand. The formula in these cells are:
Formula in the range cell:
Cell H156 =J125
Cell H157 = J151
Cell H158 = Y151

These formula links to a calculated cell to show +10, 0, -10.

Also is it ok to change the font colour, not the textbox colour please?

 

[DanteAmor]

Now, in these cells "J125, J151, Y151" do you capture values or are they also formulas?

 

[shhykk]

they are also formulas as such:

J125 = =SUM(J125:J131)
J151 = =SUM(J138:J144)
Y151= =AE151-AF151

 

[DanteAmor]

J125 = =SUM(J125:J131)

There you have a circular reference.

If you have formulas, then use the Calculate event:

Private Sub Worksheet_Calculate()
  With ActiveSheet.DrawingObjects("TextBox 10").Font
    Select Case [H156]
      Case Is < 0: .Color = vbRed
      Case Is = 0: .Color = vbYellow
      Case Is > 0: .Color = vbGreen
    End Select
  End With
  
  With ActiveSheet.DrawingObjects("TextBox 15").Font
    Select Case [H157]
      Case Is < 0: .Color = vbRed
      Case Is = 0: .Color = vbYellow
      Case Is > 0: .Color = vbGreen
    End Select
  End With
  
  With ActiveSheet.DrawingObjects("TextBox 46").Font
    Select Case [H158]
      Case Is < 0: .Color = vbRed
      Case Is = 0: .Color = vbYellow
      Case Is > 0: .Color = vbGreen
    End Select
  End With
End Sub