Find TextBoxes in a Workbook and change background colour (1 Viewer)

Indigo

Registered User.
Local time
Today, 12:55
Joined
Nov 12, 2008
Messages
241
I am hoping someone can get me over a hurdle. I have a workbook with a dozen worksheets and each worksheet contains an image and several textboxes. I need to be able to loop through each worksheet in the workbook to find specific text in a textbox and once found, change the background color to yellow. The text in the text box could be repeated across several worksheets and I need each matching textbox to be colored. I found the following code that only works on a worksheet and makes the text bold and red:

Code:
Sub FindInShape2()
On Error Resume Next

    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each shp In ActiveSheet.Shapes
        sTemp = LCase(shp.TextFrame.Characters.Text)
        iPos = InStr(sTemp, sFind)
        If iPos > 0 Then
            With shp.TextFrame.Characters(Start:=iPos, _
              Length:=Len(sFind)).Font
                .ColorIndex = 3
                .Bold = True
            End With
        End If
    Next
    MsgBox "Finished"
End Sub

So I did some more looking and modified the above code and placed in a module:

Code:
Sub FindInTB()
On Error Resume Next

    Dim wks As Worksheet, tb As TextBox
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each wks In ActiveWorkbook.Worksheets
        For Each tb In wks.TextBoxes
        sTemp = LCase(tb.TextFrame.Characters.Text)
        iPos = InStr(sTemp, sFind)
        If iPos > 0 Then
            With tb.TextFrame.Characters(Start:=iPos, _
              Length:=Len(sFind)).Font
                .ColorIndex = 3
                .Bold = True
            End With
        End If
        Next tb
    Next wks
    MsgBox "Finished"
End Sub
When I step through it, I see it looping through each worksheet, but it does not change the formatting of the textboxes. What am I missing? Your help is appreciated. Thank you.
 

Gasman

Enthusiastic Amateur
Local time
Today, 15:25
Joined
Sep 21, 2011
Messages
14,056
The code marked red does not look correct to me?

I am hoping someone can get me over a hurdle. I have a workbook with a dozen worksheets and each worksheet contains an image and several textboxes. I need to be able to loop through each worksheet in the workbook to find specific text in a textbox and once found, change the background color to yellow. The text in the text box could be repeated across several worksheets and I need each matching textbox to be colored. I found the following code that only works on a worksheet and makes the text bold and red:

Code:
Sub FindInShape2()
On Error Resume Next

    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each shp In ActiveSheet.Shapes
        sTemp = LCase(shp.TextFrame.Characters.Text)
        iPos = InStr(sTemp, sFind)
        If iPos > 0 Then
            With shp.TextFrame.Characters(Start:=iPos, _
              Length:=Len(sFind)).Font
                .ColorIndex = 3
                .Bold = True
            End With
        End If
    Next
    MsgBox "Finished"
End Sub

So I did some more looking and modified the above code and placed in a module:

Code:
Sub FindInTB()
On Error Resume Next

    Dim wks As Worksheet, tb As TextBox
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each wks In ActiveWorkbook.Worksheets
        For Each tb In wks.TextBoxes
        sTemp = LCase(tb.TextFrame.Characters.Text)
        iPos = InStr(sTemp, sFind)
        If iPos > 0 Then
            With tb.TextFrame.Characters(Start:=iPos, _
              [COLOR="Red"]Length:=Len(sFind)).Font[/COLOR]
                .ColorIndex = 3
                .Bold = True
            End With
        End If
        Next tb
    Next wks
    MsgBox "Finished"
End Sub
When I step through it, I see it looping through each worksheet, but it does not change the formatting of the textboxes. What am I missing? Your help is appreciated. Thank you.
 

Indigo

Registered User.
Local time
Today, 12:55
Joined
Nov 12, 2008
Messages
241
Hi Gasman,

The code is something I found here: https://excel.tips.net/T011281_Finding_Text_in_Text_Boxes.html

The code actually gets hung up in this line when I run it:

Code:
sTemp = LCase(tb.TextFrame.Characters.Text)

With an: Object doesn't support this property or method
error
 

Indigo

Registered User.
Local time
Today, 12:55
Joined
Nov 12, 2008
Messages
241
Thank you for responding, Gasman...

If what you meant by this statement:

"So type that statement in afresh and see what intellisense allows you.?"

is this: Code.png

it will not prompt for "TextFrame"... only Text.....

As for the link you sent, that applies to a textbox in Access. I am struggling with this issue in Excel.
 

Gasman

Enthusiastic Amateur
Local time
Today, 15:25
Joined
Sep 21, 2011
Messages
14,056
No, I used it in Excel.

There is also a .Characters.Text property which seems to return the same thing.
As you could see there is no TextFrame property for a textbox ?

Try recording a macro.

https://www.ozgrid.com/forum/forum/help-forums/excel-general/115311-vba-changing-the-color-of-some-of-the-text-in-a-textbox

According to this link, not possible with plain textbox?

http://www.vbforums.com/showthread.php?666655-changing-a-color-for-specific-string-in-text-box

so try a RichTextbox
https://stackoverflow.com/questions/39051237/insert-richtextbox-in-userform-excelvba
 
Last edited:

Darrell

Registered User.
Local time
Today, 15:25
Joined
Feb 1, 2001
Messages
299
See if this helps you...

Code:
Sub FindInTB()
On Error Resume Next

    Dim wks As Worksheet
    Dim tb As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each wks In ActiveWorkbook.Worksheets
        For Each tb In wks.Shapes
            sTemp = LCase(tb.TextFrame.Characters.Text)
            iPos = InStr(sTemp, sFind)
            If iPos > 0 Then
                With tb
                    .Fill.ForeColor.RGB = RGB(255, 255, 0)
                End With
            End If
        Next tb
    Next wks
    MsgBox "Finished"
End Sub
 

Indigo

Registered User.
Local time
Today, 12:55
Joined
Nov 12, 2008
Messages
241
Darrell,

That's fantastic! Thank you so much for taking the time to do that..... so, if I want to clear the back ground color - or reset... would it be something like this?

Code:
Sub TextBoxReset()
   Dim wks As Worksheet, tb As Shape
    For Each wks In ActiveWorkbook.Worksheets
        For Each tb In wks.Shapes
            With tb
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            End With
        Next tb
    Next wks
End Sub
because it's not quite working.... :confused:

Nevermind... when I added:

Code:
On Error Resume Next

it works just dandy!
 
Last edited:

Darrell

Registered User.
Local time
Today, 15:25
Joined
Feb 1, 2001
Messages
299
Define "not quite working"...

What you have should work so now I'm assuming that you may have shapes in your workbook other than TextBoxes which means that you will need to identify them first if you want to change their properties.

Code:
Sub TextBoxReset()
Dim wks As Worksheet
Dim tb As Shape

For Each wks In ActiveWorkbook.Worksheets
    For Each tb In wks.Shapes
        If Lcase(Left(tb.Name),7)) = "textbox" Then
            tb.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End if
    Next tb
Next wks

End Sub

So unless your texboxes have custom names this should work ok
 

Indigo

Registered User.
Local time
Today, 12:55
Joined
Nov 12, 2008
Messages
241
oh... that's a novel way to approach it, I like it....except... this line is producing a syntax error.

Code:
[COLOR=red]If Lcase(Left(tb.Name),7)) = "textbox" Then[/COLOR]
 

Darrell

Registered User.
Local time
Today, 15:25
Joined
Feb 1, 2001
Messages
299
Sorry Indigo I typed that on the fly without checking it.

Please take out the extra closing bracket after tb.name

Code:
If LCase(Left(tb.Name, 7)) = "textbox" Then
 

Users who are viewing this thread

Top Bottom