Dave: Thank you for the post! Your codedid't work at first but I had a little
more time to look at it today and I noticed an exclamation mark in place of
the "1" in the font name that was being looked for. Once I fixed that the
Macro worked perfectly.
Thanks alot; it is very much appreciated.

"Dave Peterson" wrote:

I _think_ that this does what you want.

Option Explicit
Sub FixSymbols()

Dim myRng As Range
Dim FoundCell As Range
Dim FirstAddress As String
Dim myWords As Variant
Dim wCtr As Long
Dim wks As Worksheet
Dim StartPos As Long
Dim CurPos As Long

myWords = Array("6")

For Each wks In ActiveWorkbook.Worksheets
With wks
'change this to the range that should be inspected
Set myRng = .Range("A1:M36")

With myRng
For wCtr = LBound(myWords) To UBound(myWords)
FirstAddress = ""
With .Cells
Set FoundCell = .Find(What:=myWords(wCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'do nothing, it wasn't found
MsgBox myWords(wCtr) & " wasn't found!"
Else
FirstAddress = FoundCell.Address
Do
CurPos = 1
Do
StartPos = InStr(CurPos, FoundCell.Value, _
myWords(wCtr), _
vbTextCompare)
If StartPos = 0 Then
Exit Do
Else
If FoundCell.Characters _
(Start:=StartPos, _
Length:= _
Len(myWords(wCtr))).Font _
.Name = _
"UniversalMath! BT" Then

With FoundCell.Characters _
(Start:=StartPos, _
Length:= _
Len(myWords(wCtr))).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 12
End With

With FoundCell.Characters _
(Start:=StartPos, _
Length:=Len(myWords(wCtr)))
.Text = "±"
End With
End If
End If
CurPos = StartPos + 1
Loop

'look for the next one
Set FoundCell = _
.FindNext(after:=FoundCell)

'since you're changing the character
'it may not be found at the end
If FoundCell Is Nothing Then
Exit Do
End If

If FirstAddress = _
FoundCell.Address Then
'at the first address
Exit Do
End If
Loop
End If
End With
Next wCtr
End With
End With
Next wks

MsgBox "FixSymbols Done!"

End Sub


Dallas wrote:

Sorry! When I copy and pasted my macro over to the post part of some of the
lines of code got pushed to the next line. Here it is again.

Option Explicit
Sub FixSymbols()

Dim myRng As Range
Dim FoundCell As Range
Dim FirstAddress As String
Dim myWords As Variant
Dim wCtr As Long
Dim wks As Worksheet
Dim StartPos As Long
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

Set wks = Worksheets(myValue - Counter + 1)

'change this to the list of words to find
myWords = Array("6")

With wks
'change this to the range that should be inspected
Set myRng = .Range("A1:M36")

With myRng
For wCtr = LBound(myWords) To UBound(myWords)
FirstAddress = ""

With .Cells
Set FoundCell = .Find(What:=myWords(wCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'do nothing, it wasn't found
MsgBox myWords(wCtr) & " wasn't found!"
Else
FirstAddress = FoundCell.Address
Do
StartPos = InStr(1, FoundCell.Value, _
myWords(wCtr), _
vbTextCompare)
If StartPos = 0 Then
'this shouldn't happen,
'since the .find worked ok
Else
If FoundCell.Characters _
(Start:=StartPos, _
Length:= _
Len(myWords(wCtr))).Font _
.Name = _
"UniversalMath! BT" Then
With FoundCell.Characters _
(Start:=StartPos, _
Length:= _
Len(myWords(wCtr))).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 12
End With

With FoundCell.Characters _
(Start:=StartPos, _
Length:=Len(myWords(wCtr)))
.Text = "±"
End With

'look for the next one
Set FoundCell = _
.FindNext(after:=FoundCell)

If FirstAddress = _
FoundCell.Address Then
'at the first address
Exit Do
End If

Else 'look for the next one
Set FoundCell = _
.FindNext(after:=FoundCell)
End If

If FirstAddress = _
FoundCell.Address Then
'at the first address
Exit Do
End If
End If
Loop
End If
End With
Next wCtr
End With
End With

Loop
MsgBox "FixSymbols Done! "

End Sub

--

Dave Peterson