Search code examples
vbaexcelexcel-2013

Text Box Conditional Formatting - Excel VBA

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
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