Question

I have a dashboard excel spreadsheet that has textboxes. In each text box is a formula pointing to a cell where a formula is applied to the raw data.

I am looking for a way to conditionally format the text boxes depending on either the value in the text box or the raw data behind if that's easier. Essentially if a textbox has a value over one I would like the font to be green if it is under I would like it to be red. I've had a hard time doing this so far and would appreciate anyones help. Below is my code so far but it wont run. I am a bit of a novice when it comes to VBA.

Sub Test_Change_Text()

If ActiveSheet.Range("A1").Value > ActiveSheet.Range("B1").Value Then
ActiveSheet.Shapes.Range(Array("textbox 1")).Select
 With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font.Fill
  .Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
Else
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font.Fill
  .Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
End With
End With

End Sub

screenshot dashboard

Update: The code below is my final working code. This allows for three constraints.

Sub ChangeText()
    Dim shap As Shape

    For Each shap In Sheets("Output").Shapes
        If shap.Type = msoTextBox Then
            If IsNumeric(shap.TextEffect.Text) Then
                If shap.TextEffect.Text >= 3 Then
                    shap.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 0)
                Else
                    If shap.TextEffect.Text <= -3 Then
                        shap.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
                    Else
                        shap.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                    End If
                End If

            End If
        End If
    Next shap

    MsgBox "Done"
End Sub
Was it helpful?

Solution

If they are regular textboxes (i.e. Insert > Text Box) you could try this

Sub ChangeText(sht As Worksheet)
    Dim shap As Shape
    For Each shap In sht.Shapes
        If shap.Type = msoTextBox Then
            If IsNumeric(shap.TextEffect.Text) Then
                With shap.TextFrame2.TextRange.Font.Fill.ForeColor
                If CDbl(shap.TextEffect.Text) > 0 Then
                    .RGB = RGB(0, 255, 0)
                Else
                    .RGB = RGB(255, 0, 0)
                End If
                End With
            End If
        End If
    Next shap

End Sub

OTHER TIPS

Assuming your "textboxes" are really shapes with linked text content:

Sub DoColor()

Dim shp As Shape, tmp

    For Each shp In ActiveSheet.Shapes
        'only operate on linked shapes
        If Len(shp.DrawingObject.Formula) > 0 Then
            tmp = shp.TextFrame.Characters.Text
            'ignore non-numeric values
            If IsNumeric(tmp) And Len(tmp) > 0 Then
                shp.TextFrame.Characters.Font.Color = _
                          IIf(tmp >= 0, vbGreen, vbRed)
            End If
        End If
    Next shp


End Sub
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top