I tried somthing similar already but I went ahead and tried this one. The
first time I ran it it skipped over any cell that didnt' have a 6 in it so
ont the line that reads
If R.Value Like "*6*" Then
to
If R.Value Like "*" Then
When I ran the macro this time I had the same problem as before. It fixes
everything up to the cell that has the two symbols side by side in the same
font and changes both w and f characters to Neuropole font and w to V. Then
Excel Locks up and when I End Task in Windows Task Manager VBA pops up the
error "Unable to get the Font property of the Characters class" and proceeds
to highlight the line:
If .Font.Name = "UniversalMath1 BT" Then
When you look at the code it should work but it doesn't. I'm getting pretty
frustrated and I need a solution to this problem. Thank you for your
continued support.

"Rick Rothstein" wrote:

Give this macro a try (I didn't test it, but I'm pretty sure it will
work)...

Sub SubstituteCharacters()
Dim X As Long
Dim R As Range
Dim Before As Variant
Dim After As Variant
For Each R In Worksheets("Sheet1").UsedRange
If R.Value Like "*6*" Then
For X = 1 To Len(R.Value)
With R.Characters(X, 1)
If .Font.Name = "UniversalMath1 BT" Then
If .Text = "6" Then
.Font.Name = "Calibri"
.Text = Chr(177)
.Font.FontStyle = "Regular"
.Font.Size = 12
End If
ElseIf .Font.Name = "GDT" Then
If .Text = "f" Then
.Font.Name = "Arial"
.Text = Chr(216)
.Font.FontStyle = "Regular"
.Font.Size = 10
ElseIf .Text = "w" Then
.Font.Name = "Neuropol"
.Text = "V"
.Font.FontStyle = "Regular"
.Font.Size = 11
End If
ElseIf .Font.Name = "Symbol" Then
If .Text = "f" Then
.Font.Name = "Arial"
.Text = Chr(216)
.Font.FontStyle = "Regular"
.Font.Size = 10
End If
End If
End With
Next
End If
Next
End Sub

--
Rick (MVP - Excel)


"Dallas" wrote in message
...
Sorry for the confusion. Here is what I need changed.

"UniversalMath1 BT" "6" to "Calibri" "Chr(177)" "12"

"GDT" "f" to "Arial" "Chr(216)" "10"

"Symbol" "f" to "Arial" "Chr(216)" "10"

"GDT" "w" to "Neuropol" "Chr(86)" "11"

Thanks again for your help.

"Rick Rothstein" wrote:

Can you clarify the FROM and TO font names and symbols... your text
description and your code appear to be different. List them across in
this
order for us (one conversion per line) please...

"From Font Name" "From Character" "To Font Name" "To Character" "To Size"

--
Rick (MVP - Excel)


"Dallas" wrote in message
...
Some more Help Please! I guess I should have mentioned before that I
have
other symbols I neet to fix as well. The problem seems to be when I
have
two
symbols next to each other in the same font. When I run a variation of
your
macro It changes the font on both of them and then excel locks up. The
error
that I get is
"Unable to get the Font property of the Character class". The cell that
the
error occurs on reads wf.840 where the w represents a countersink
symbol
in
font "GDT"
and "f" represents a diameter symbol in the same font. The rest of the
characters in the cell are in the "Arial" font. I need to Change the
"w"
to a
capital "V" in the "Neuropol" and the "f" to the diameter symbol or
Chr(216)
in th "Arial". I als need the macro to look for "f" in the "Symbol"
font
and
change it to the the diameter symbol. When I use Dave's macro it runs
without
errors but if I search for the "f" first on the same cell it changes
the
font
on both the "f" and the "w" to "Arial" and if I search for the "w"
first
it
changes the font of the whole cell to "Neuropol". I would like to
change
everything in one macro but seperate macros for each is fine too; I
will
run
a sepeate macro to cycle through them if I have too.
Please give me what ever suggestions you might have. Thank You.

p.s. Here is the modified code. I tried alot variations to make one
macro
for everything but finally ended with this, seperate macros for each.

Sub FixPlusMinusSymbol()
Dim X As Long
Dim R As Range
Dim myValue As Variant
Dim Counter As Variant
Dim myNum As Variant

myValue = ActiveWorkbook.Sheets.Count
Dim ChkLastUntil()
Counter = 0
myNum = myValue
Do Until myNum = 0
myNum = myNum - 1
Counter = Counter + 1
For Each R In Worksheets(myValue - Counter + 1).UsedRange
If R.Value Like "*6*" Then
For X = 1 To Len(R.Value)
With R.Characters(X, 1)
If .Font.Name = "UniversalMath1 BT" Then
If .Text = "6" Then
.Font.Name = "Calibri"
.Text = Chr(177) ' the plus/minus sign
.Font.FontStyle = "Regular"
.Font.Size = 12
End If
End If
End With
Next
End If
Next
Loop
MsgBox "FixPlusMinus Done!"
End Sub
Sub FixDiameterSymbol1()
Dim X As Long
Dim R As Range
Dim myValue As Variant
Dim Counter As Variant
Dim myNum As Variant

myValue = ActiveWorkbook.Sheets.Count
Dim ChkLastUntil()
Counter = 0
myNum = myValue
Do Until myNum = 0
myNum = myNum - 1
Counter = Counter + 1
For Each R In Worksheets(myValue - Counter + 1).UsedRange
If R.Value Like "*f*" Then
For X = 1 To Len(R.Value)
With R.Characters(X, 1)
If .Font.Name = "GDT" Then
If .Text = "f" Then
.Font.Name = "Arial"
.Text = Chr(216) ' the diameter sign
.Font.FontStyle = "Regular"
.Font.Size = 10
End If
End If
End With
Next
End If
Next
Loop
MsgBox "FixDiameter1 Done!"
End Sub
Sub FixDiameterSymbol2()
Dim X As Long
Dim R As Range
Dim myValue As Variant
Dim Counter As Variant
Dim myNum As Variant

myValue = ActiveWorkbook.Sheets.Count
Dim ChkLastUntil()
Counter = 0
myNum = myValue
Do Until myNum = 0
myNum = myNum - 1
Counter = Counter + 1
For Each R In Worksheets(myValue - Counter + 1).UsedRange
If R.Value Like "*f*" Then
For X = 1 To Len(R.Value)
With R.Characters(X, 1)
If .Font.Name = "Symbol" Then
If .Text = "f" Then
.Font.Name = "Arial"
.Text = Chr(216) ' the diameter sign
.Font.FontStyle = "Regular"
.Font.Size = 10
End If
End If
End With
Next
End If
Next
Loop
MsgBox "FixDiameter2 Done!"
End Sub
Sub FixCountersinkSymbol()
Dim X As Long
Dim R As Range
Dim myValue As Variant
Dim Counter As Variant
Dim myNum As Variant

ActiveWorkbook.Sheets(1).Activate
myValue = ActiveWorkbook.Sheets.Count
Dim ChkLastUntil()
Counter = 0
myNum = myValue
Do Until myNum = 0
myNum = myNum - 1
Counter = Counter + 1
For Each R In Worksheets(myValue - Counter + 1).UsedRange
If R.Value Like "*w*" Then
For X = 1 To Len(R.Value)
With R.Characters(X, 1)
If .Font.Name = "GDT" Then
If .Text = "w" Then
.Font.Name = "Neuropol"
.Text = Chr(86) ' the countersink sign
.Font.FontStyle = "Regular"
.Font.Size = 11
End If
End If
End With
Next
End If
Next
Loop
MsgBox "FixCountersink Done!"
End Sub


"Rick Rothstein" wrote:

I didn't go through your code in detail, but from what I gather you
are
trying to do, I think this shorter macro will work for you...

Sub InsertPlusMinusSymbol()
Dim X As Long
Dim R As Range
For Each R In Worksheets("Sheet1").UsedRange
If R.Value Like "*6*" Then
For X = 1 To Len(R.Value)
With R.Characters(X, 1)
If .Font.Name = "UniversalMath1 BT" Then
If .Text = "6" Then
.Font.Name = "Calibri"
.Text = Chr(177) ' the plus/minus sign
.Font.FontStyle = "Regular"
.Font.Size = 12
End If
End If
End With
Next
End If
Next
End Sub

--
Rick (MVP - Excel)