Superscript Registered symbol

[Guest]

I'm creating acombination of worksheets that will allow me to generate a
printable report page, based on technical and non-technical information input
on a collecting worksheet. Depending on my selections/answers, information
will be copied, displayed, hidden, etc. Some of my information includes the
registered symbol, ®, but I want it to be in superscript. Originally I
formatted the character in the source cells, but only the contents are copied
by my formulas, not the formats. I tried the following macro, to no avail:

Sub FancyR()
With Application.ReplaceFormat.Font
.Superscript = True
.Subscript = False
End With
Cells.Replace What:="®", Replacement:="®", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
End Sub

This macro simply finds an instance and superscripts the entire cell.
That's definitely not what I was intending. Also, it doesn't find the symbol
in any of the cells that have been copied, so they're completely untouched.
Any suggestions? Or, can this even be done?

 

[Dave Peterson]

If the cells that aren't working are formulas, then that's the way excel works.
If the cells are numeric and just show the (R) symbol because of formatting,
then that's the way excel works.

But if the cells are text and actually contain those symbols, you're going to
have to dump the "Replace All" technique and loop through the cells--and loop
through the value in the cells (if the cell has multiple (R) symbols).

This worked ok for me:

Option Explicit
Sub FancyR()

Dim RegTM As String
Dim FirstAddress As String
Dim FoundCell As Range
Dim wks As Worksheet
Dim HowMany As Long
Dim iPos As Long
Dim StartPos As Long

RegTM = Chr(174) '®

Set wks = Worksheets("sheet1")

With wks
With .Cells
Set FoundCell = .Find(what:=RegTM, after:=.Cells(.Cells.Count), _
LookIn:=xlValues, lookat:=xlPart, _
searchorder:=xlByRows, _
MatchCase:=False, searchdirection:=xlNext)

If FoundCell Is Nothing Then
MsgBox RegTM & " not found!"
Exit Sub
End If

FirstAddress = FoundCell.Address

Do
StartPos = 1
Do
iPos _
= InStr(StartPos, FoundCell.Value, RegTM, vbTextCompare)
If iPos = 0 Then
Exit Do
End If
FoundCell.Characters(Start:=iPos, Length:=1) _
.Font.Superscript = True
StartPos = iPos + 1
Loop

Set FoundCell = .FindNext(after:=FoundCell)

If FoundCell.Address = FirstAddress Then
Exit Do
End If

Loop

End With
End With
End Sub

 

[Dave Peterson]

Those first two sentences could have been nicer.

Excel doesn't allow this character by character formatting in formulas or
numbers--only text.

 

[Guest]

Don't worry too much about being nice. I appreciate the answer, although I
was hoping for a different one. All the text is either generated by a
formula or copied from the input page (which is a formula too, I guess), so
it looks like I'll be out of luck. I'm still going to try your code to see
if it'll help at all. Thanks.

 

[Dave Peterson]

If the stuff in the cells remain formulas, then yep, you're out of luck.

But if you paste special|values, then it'll work.