Change text color in a textbox

[zinah]

Hi,

I have this macro that should change the text color in a textbox with conditions:

- If value < 3% then change text color to red
- If value > 3% then change text color to blue
- Else color to black

The textbox names are : 2018_Delta, 2017_Delta, and 2016_Delta

The macro changes the font to blue instead of conditions I set, can you help please?




Sub Color_Change()
Dim t2Sht As Worksheet
Set t2Sht = Sheets("It would take")
t2Sht.Activate


Dim D_shps As Variant, Me_shp As Shape
D_shps = Array("2018", "2017", "2016")


For Each itm In D_shps
Set D_shp = ActiveSheet.Shapes(itm & "_Delta")
With D_shp
If .TextFrame.Characters.Text < -0.03 Then
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)

ElseIf .TextFrame.Characters.Text > 0.03 Then
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)

Else: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
End If
End With
Next itm




End Sub

 

[EFANYoutube]

If .TextFrame.Characters.Text < -0.03 Then
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)​

Issue I this is you are saying
if < -3% then Red
if > 3% then Blue
else Black

Try:

[LEFT][COLOR=#333333][FONT=Verdana]If .TextFrame.Characters.Text < 0.03 Then[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)[/FONT][/COLOR][/LEFT]

 

[zinah]

Hi, thank you for your help. I tired and it didn't work too. It kept the all text in Blue

 

[DanteAmor]

What do you have in the textbox?
2
or 2%
or .02


If you have 2 or 2% then:

Sub Color_Change()
    Dim t2Sht As Worksheet
    Set t2Sht = Sheets("It would take")
    t2Sht.Activate
    Dim D_shps As Variant, Me_shp As Shape
    D_shps = Array("2018", "2017", "2016")
    For Each itm In D_shps
        Set d_shp = ActiveSheet.Shapes(itm & "_Delta")
        With d_shp
            valor = Replace(.TextFrame.Characters.Text, "%", "")
            Select Case valor
                Case Is < 3: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
                Case Is > 3: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
                Case Else:   .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            End Select
        End With
    Next itm
End Sub

But if you have 0.02 Then:

Sub Color_Change()
    Dim t2Sht As Worksheet
    Set t2Sht = Sheets("It would take")
    t2Sht.Activate
    Dim D_shps As Variant, Me_shp As Shape
    D_shps = Array("2018", "2017", "2016")
    For Each itm In D_shps
        Set d_shp = ActiveSheet.Shapes(itm & "_Delta")
        With d_shp
            valor = Replace(.TextFrame.Characters.Text, "%", "")
            Select Case valor
                Case Is < 0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
                Case Is > 0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
                Case Else:   .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            End Select
        End With
    Next itm
End Sub

 

[zinah]

Hi, thank you so much, the macro worked and considered the decimal. However, it changed a value that is less than +0.3 to blue instead of black.
the condition that I want is any value that is less than -0.03 is red, and more than +0.03 to blue, else black

Sub Color_Change() Dim t2Sht As Worksheet
Set t2Sht = Sheets("It would take")
t2Sht.Activate
Dim D_shps As Variant, Me_shp As Shape
D_shps = Array("2018", "2017", "2016")
For Each itm In D_shps
Set d_shp = ActiveSheet.Shapes(itm & "_Delta")
With d_shp
valor = Replace(.TextFrame.Characters.Text, "%", "")
Select Case valor
Case Is < 0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
Case Is > 0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
Case Else: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
End Select
End With
Next itm
End Sub

 

[DanteAmor]

the condition that I want is any value that is less than -0.03 is red, and more than +0.03 to blue, else black

Sub Color_Change()
    Dim t2Sht As Worksheet
    Set t2Sht = Sheets("It would take")
    t2Sht.Activate
    Dim D_shps As Variant, Me_shp As Shape
    D_shps = Array("2018", "2017", "2016")
    For Each itm In D_shps
        Set d_shp = ActiveSheet.Shapes(itm & "_Delta")
        With d_shp
            valor = Replace(.TextFrame.Characters.Text, "%", "")
            Select Case valor
                [COLOR=#0000ff]Case Is < -0.03[/COLOR]: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
                Case Is > 0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
                Case Else:   .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            End Select
        End With
    Next itm
End Sub

 

[zinah]

This is what I have, the values that I have are: -2.0% has changed to red, and 4.2%, 1.0% have changed to blue, what I want is 1.0% to be black as it's less than 3.0%.

Sub Color_Change2()
Dim t2Sht As Worksheet
Set t2Sht = Sheets("It would take")
t2Sht.Activate
Dim D_shps As Variant, Me_shp As Shape
D_shps = Array("2018", "2017", "2016")
For Each itm In D_shps
Set d_shp = ActiveSheet.Shapes(itm & "_Delta")
With d_shp
valor = Replace(.TextFrame.Characters.Text, "%", "")
Select Case valor
Case Is < -0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
Case Is > 0.03: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
Case Else: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
End Select
End With
Next itm
End Sub

 

[DanteAmor]

What do you have in the textbox?
2
or 2%
or .02

 

[zinah]

I have: -2.0%, 4.2% and 1.0%

 

[DanteAmor]

-4.0 < -3.0 (Red)
4.2 > 3.0 (Blue)
1.0 (Black)
-2.0 (Black, because -2 is not less than -3)

Try this

Sub Color_Change()
    Dim t2Sht As Worksheet
    Set t2Sht = Sheets("It would take")
    t2Sht.Activate
    Dim D_shps As Variant, Me_shp As Shape
    D_shps = Array("2018", "2017", "2016")
    For Each itm In D_shps
        Set d_shp = ActiveSheet.Shapes(itm & "_Delta")
        With d_shp
            valor = Val(Replace(.TextFrame.Characters.Text, "%", ""))
            Select Case valor
                Case Is < -3: .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)   'red
                Case Is > 3:  .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)   'blue
                Case Else:    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)     'black
            End Select
        End With
    Next itm
End Sub