Change specific text font color in shapes

[zinah]

Hi,

I have shapes that have text and I need to change the text font color of any "please change color to blue - example" if it's found in shapes. How can I do that in a macro?

 

[DanteAmor]

Try this:

Change data in red by your information

Sub Macro9()
    wText = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Shapes("[COLOR=#ff0000]Shapetst[/COLOR]").TextFrame.Characters.Text
    wString = "[COLOR=#ff0000]please change color to blue[/COLOR]"
    n = InStr(1, wText, wString)
    l = Len(wString)
    If n > 0 Then
        Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Shapes("[COLOR=#ff0000]Shapetst[/COLOR]").TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = [COLOR=#ff0000]5[/COLOR]
    End If
End Sub

 

[zinah]

How can I write it within below macro?

   Set aSht = ActiveSheet    Set rSht = Sheets("Role Scorecard")
    rSht.Activate




Dim oCnt As Long, o As Long '>>>set the limit of objectives count
Dim shp As Shape
Dim ObjRng As Range, MetRng As Range, catRng As Range
Dim objLbl As Shape, outLbl As Shape, catLbl As Shape
Dim prgTxt As String, prglbl As String


oCnt = 20
If oCnt > 5 Then oCnt = 5


    Set ObjRng = Sheets("ref.").[Pop_ObjRng]
    Set MetRng = Sheets("ref.").[Pop_OutRng]
    Set numRng = Sheets("ref.").[NumRange]
    Set catRng = Sheets("ref.").[CatRange]
    Set PrgRng = Sheets("ref.").[ProgRange]
    Set ModRng = Sheets("ref.").[Mod_Date]


    
For o = 1 To oCnt


For lbl = ObjRng.Row To (ObjRng.Row + ObjRng.Rows.Count - 1)
    i = i + 1
    
    For Each shp In ActiveSheet.Shapes
    If InStr(1, shp.Name, "Goal_" & i & "_Obj") > 0 Then
        With shp
            .TextFrame2.TextRange.Characters.Text = Sheets("ref.").Cells(lbl, numRng.Column) & " " & "Objective: " & "Last modified" & " " & Sheets("ref.").Cells(lbl, ModRng.Column).Value & Chr(10) & Sheets("ref.").Cells(lbl, ObjRng.Column).Value
            .TextFrame2.TextRange.Font.Bold = msoFalse
            '.TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, ObjRng), Len(ObjRng)).Font.Bold = True
            .TextFrame2.TextRange.Characters(1, 14).Font.Bold = msoCTrue
    
        End With
    End If
    
    If InStr(1, shp.Name, "Goal_" & i & "_Out") > 0 Then
        With shp
        .TextFrame2.TextRange.Characters.Text = "Metrics/Outcomes: " & Chr(10) & Sheets("ref.").Cells(lbl, MetRng.Column).Value
        .TextFrame2.TextRange.Font.Bold = msoFalse
        .TextFrame2.TextRange.Characters(1, 17).Font.Bold = msoCTrue
        End With
    End If
    
    If InStr(1, shp.Name, "Goal_" & i & "_Cat") > 0 Then
        With shp
        .TextFrame2.TextRange.Characters.Text = Sheets("ref.").Cells(lbl, catRng.Column).Value
        .TextFrame2.TextRange.Font.Bold = msoFalse
        End With
    End If
    
    If InStr(1, shp.Name, "Goal_" & i & "_Prg") > 0 Then
        With shp
        .TextFrame2.TextRange.Characters.Text = "Progress Notes: " & Chr(10) & Sheets("ref.").Cells(lbl, PrgRng.Column).Value
        .TextFrame2.TextRange.Font.Bold = msoFalse
        .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, prgTxt), Len(prgTxt)).Font.Bold = False
        prglbl = "Progress Notes: "
        prgTxt = Sheets("ref.").[G_Prog].Offset(1, 0).Value
        .TextFrame2.TextRange.Characters.Text = prglbl & prgTxt
        .TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, prgTxt), Len(prgTxt)).Font.Bold = True
        .TextFrame.Characters(InStr(1, (prglbl & prgTxt), prgTxt), Len(prgTxt)).Font.Color = RGB(0, 0, 255)
        If prgTxt = "NO" Then _
        .TextFrame.Characters(InStr(1, (prglbl & prgTxt), prgTxt), Len(prgTxt)).Font.Color = RGB(255, 0, 0)
        
        
        End With
        
        
    End If
    
    Next shp
Next lbl
Next o

 

[DanteAmor]

What is the text you want to search?
You could explain with a real example, what do you have of text in the shape, what are you going to look for and what do you want to change color?

 

[zinah]

These boxes that macro generates have different text that depends on each employee goal, the text may or may not have this text “ more details can be found in our system” this specific text maybe included in any shape name that includes “goal_& i&_obj” and “goal_& I &_out”
does that make sense?

 

[DanteAmor]

I show you an example

[COLOR=#0000ff]    wString = "more details can be found in our system"[/COLOR]
[COLOR=#0000ff]    l = Len(wString)[/COLOR]
    For o = 1 To oCnt
        For lbl = ObjRng.Row To (ObjRng.Row + ObjRng.Rows.Count - 1)
            i = i + 1
            For Each shp In ActiveSheet.Shapes
                If InStr(1, shp.Name, "Goal_" & i & "_Obj") > 0 Then
                    With shp
                        [COLOR=#0000ff]wText [/COLOR]= Sheets("ref.").Cells(lbl, numrng.Column) & " " & _
                            "Objective: " & "Last modified" & " " & _
                            Sheets("ref.").Cells(lbl, ModRng.Column).Value & Chr(10) & _
                            Sheets("ref.").Cells(lbl, ObjRng.Column).Value
                        .TextFrame2.TextRange.Characters.Text = wText
                        .TextFrame2.TextRange.Font.Bold = msoFalse
                        '.TextFrame.Characters(InStr(1, .TextFrame2.TextRange.Characters.Text, ObjRng), Len(ObjRng)).Font.Bold = True
                        .TextFrame2.TextRange.Characters(1, 14).Font.Bold = msoCTrue
[COLOR=#0000ff]                        n = InStr(1, wText, wString)[/COLOR]
[COLOR=#0000ff]                        If n > 0 Then[/COLOR]
[COLOR=#0000ff]                            shp.TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = 5[/COLOR]
[COLOR=#0000ff]                        End If[/COLOR]
                    End With
                End If

 

[zinah]

I have updated my macro with blue text but there was no change, did I miss anything?

 

[DanteAmor]

Try this:

Change data in red by your information

Sub Macro9()
    wText = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Shapes("[COLOR=#ff0000]Shapetst[/COLOR]").TextFrame.Characters.Text
    wString = "[COLOR=#ff0000]please change color to blue[/COLOR]"
    n = InStr(1, wText, wString)
    l = Len(wString)
    If n > 0 Then
        Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Shapes("[COLOR=#ff0000]Shapetst[/COLOR]").TextFrame.Characters(Start:=n, Length:=l).Font.ColorIndex = [COLOR=#ff0000]5[/COLOR]
    End If
End Sub

Did you do a small test with the first code?

 

[zinah]

Yes, I did and the text changed to blue but with original file it didn't work

here's a test file

https://www.dropbox.com/s/fgfnqup0o41fv2k/Book1.xlsm?dl=0

 

[zinah]

here's a test file

https://www.dropbox.com/s/0yuoqpsot0z7gfd/Book1.xlsm?dl=0