Finding and Replacing in Text Boxes

This is a great macro---thank you! Is there a way to keep the source formatting in the text that you are replacing? All of the text in my text box becomes bold font. Id prefer it to stay the same as what the text was before I replaced it.

@ Theresa

The trick is to put a "For Each WorkSheet...Next Worksheet" loop around the "For Each sh...Next" loop.

Try this. It also uses Input Boxes instead of hardcoding for sOld and sNew.

Sub TextBoxReplace()
Dim shp As Shape
Dim sOld As String
Dim sNew As String
Dim wks As Worksheet
'Change as desired
sOld = InputBox("Replace this...")
sNew = InputBox("with this...")
On Error Resume Next
For Each wks In ActiveSheet.Parent.Worksheets
For Each shp In wks.Shapes
With shp.TextFrame.Characters
.Text = Application.WorksheetFunction.Substitute( _
.Text, sOld, sNew)
End With
Next shp
Next wks
End Sub

For the TextBoxReplace code - how would you loop through the entire workbook with multiples sheets to perform the same function on each sheet rather than one at a time?

@Curt

Not sure why you are having an issue or what problem you're having.

I'll start with the assumption you are running the code as-is, below that I'll address what one change you may have tried might have caused it to not work.

I did notice that your "double space (" ")" in your post has only one space. (Unlikely cause, but I thought I would mention it because I've done such things.). Also, when I ran the code if there are three consecutive spaces and the result is two consecutive spaces. That means re-running should clear those, but it doesn't completely do the trick since there could be longer strings of spaces than 3.

There are two approaches you might try.

First, to remove excess spaces you can use the Application.Worksheet.Trim function. To do this, replace "Application.WorksheetFunction.Substitute().Text, sOld, sNew)" with "Application.WorksheetFunction.Trim(.Text)". Two notes: The VBA Trim() function won't suffice, you need the Worksheet Trim(). The Trim() function with also remove leading and trailing.

Second, you can loop-test the .Text to see if it still has and occurrences of sOld.

With shp.TextFrame.Characters
Do Until InStr(1, .Text, sOld) = 0
.Text = Application.WorksheetFunction.Substitute( _
.Text, sOld, sNew)
Loop
End With

Hi,

Thanks for all the great macros I've been able to use on a daily basis!

I tried using TextBoxReplace to search for a double space (" ") in text boxes and replace with a single space (" "). I can't seem to get it to work. I've tried to figure it out, but don't have the skill. Any chance you could help?

For groups as well:

Sub Repl()
Dim shp As Shape
Dim sOld As String
Dim sNew As String

'Change as desired
sOld = "77x10m"
sNew = "75x10m"
On Error Resume Next
For Each shp In ActiveSheet.Shapes
With shp.TextFrame.Characters
.Text = Application.WorksheetFunction.Substitute( _
.Text, sOld, sNew)
End With
For Each gri In shp.GroupItems
With gri.TextFrame.Characters
.Text = Application.WorksheetFunction.Substitute( _
.Text, sOld, sNew)
End With
Next
Next
End Sub

You are a miracle worker!
Thank you so much for this VBA!
I've been searching for 4 hours and WOW.

Thank you once again :-)

Hi,
Pl note that each Rectangular shape is one below the other in order and each connected with a ARROW to next Rectangular shape.

Hi,

can you pl help me with a macro code for the below task in excel 2007.I am new to macros.

1.In Sheet1 I have 100+ Rectangular shapes each containing one text box containing Text
2.I want these Text of each box to be replaced with text from Sheet2 Range A1 to A100+ retaining Text Formating of Sheet2 text.
Appreciate your timely help.