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)