Replace font of one character in a string

[Guest]

I need to replace the font of one character in a text string in a range of
cells.
I can do this character by character by hand but I want to automate it.
If I use the replace function for one character than the font change is
applied to all characters in the cell while the font style (e.g. bold to
italic) is limited to the one specified character.
Does anyone know how to change the the font for only one character in such
a way that I can automate it. (e.g. All arial "1" need to be replaced by
windings "1 with a circle around it")

 

[Ron Rosenfeld]

I need to replace the font of one character in a text string in a range of
cells.
I can do this character by character by hand but I want to automate it.
If I use the replace function for one character than the font change is
applied to all characters in the cell while the font style (e.g. bold to
italic) is limited to the one specified character.
Does anyone know how to change the the font for only one character in such
a way that I can automate it. (e.g. All arial "1" need to be replaced by
windings "1 with a circle around it")

You can do it with a simple macro.

To enter the macro,

<alt-F11> opens the VB Editor.

Ensure your project is selected in the project explorer window, then
Insert/Module and paste the code below into the window that opens.

Read the notes in the code.

You can use it by selecting the area where you want this to occur, then
executing the macro.

===========================================
Option Explicit

Sub WingdingReplace()
Dim c As Range
Dim sWD1 As String
Dim i As Long

sWD1 = Chr(129) 'wingding encircled 1

'can only apply this to text strings, and not to strings that
'are the result of formulas.

'This does not work on formulas.
'If you want it to do so, you will have to also replace
' the formula with a plain text string.

For Each c In Selection
If c.HasFormula = False Then
c.Value = Replace(c.Text, "1", sWD1)
For i = 1 To Len(c.Text)
If Mid(c.Text, i, 1) = sWD1 Then
With c.Characters(Start:=i, Length:=1).Font
.Name = "Wingdings"
'this line may not be necessary but looked better on my screen
.Size = .Size + 2
End With
End If
Next i
End If
Next c

End Sub
=========================================
--ron

 

[Guest]

Or you can do a dirty way by hand. Copy the range and paste them in a new
sheet. And use the replace all function. And Copy and paste it back.

If you have formula included in the sheet.
Copy the whole sheet to a new one, replace all, and only copy the range and
paste it back.

 

[Ron Rosenfeld]

Or you can do a dirty way by hand. Copy the range and paste them in a new
sheet. And use the replace all function. And Copy and paste it back.

If you have formula included in the sheet.
Copy the whole sheet to a new one, replace all, and only copy the range and
paste it back.

Did you try your solution?

When I tried it, it did not change the font, but rather displayed a small box.


--ron