Macro to test characters with block of cells and change font

[Guest]

Hello,

I want to create a macro to test across a range of cells. In the below
attempt at the code, I assumed that the user has highlighted the desired
block. I want to test the contents of each cell, and to format superscript
only aphabetic characters (not numeric, and certainly not the entire cell).
The data I'm working with is primarily numeric, and any alphabetic characters
are a statistics notation. It would greatly save our graphics folks time to
have this macro that will superscript all alphabet characters while not
touching the numeric characters.

I cobbled together the below code based on code I found on F. David
McRitchie's webpage (http://www.mvps.org/dmcritchie/excel/join.htm). It kinda
works. But it only superscripts alpha characters the first cell in the
highlighted range. I need it to superscript for all cells in the highlighted
range.

Option Explicit
Sub SuperscriptLetters()
Dim cell As Range
Dim i As Integer

On Error Resume Next 'in case nothing found

For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
If Len(cell) > 0 Then
For i = Len(cell) To 1 Step -1
If Mid(cell, i, 1) = "A" Then
With ActiveCell.Characters(Start:=i, Length:=1).Font
.Superscript = True
End With
End If
Next i
End If
Next cell

End Sub

Thank you in advance for any assistance!
Carolyn

 

[Guest]

Option Explicit
Sub SuperscriptLetters()
Dim cell As Range
Dim i As Integer

On Error Resume Next 'in case nothing found

For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
If Len(cell) > 0 Then
For i = Len(cell) To 1 Step -1
If Not IsNumeric(Mid(cell, i, 1)) Then
With cell.Characters(Start:=i, Length:=1).Font
.Superscript = True
End With
End If
Next i
End If
Next cell

End Sub

this superscripts everything that isn't a 1-9.

 

[Guest]

Thank you very much for you assistance Tom. My graphics person is doing
cartwheels. Carolyn

 

[Tom Ogilvy]

Carolyn,

You did all the work - I just did some minor tweaking. Pat yourself on the
back <g>

 

[Guest]

Here's the final macro that we've implemented. It could probably be
streamlined a bit more, but it's functional and meets our needs. Enjoy!
Carolyn

Option Explicit
Sub SuperscriptLetters()
Dim cell As Range
Dim i As Integer

On Error Resume Next 'in case nothing found

For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
If Len(cell) > 0 Then
For i = Len(cell) To 1 Step -1
If Not (IsNumeric(Mid(cell, i, 1)) Or Mid(cell, i, 1) = "%" Or
Mid(cell, i, 1) = "$" Or Mid(cell, i, 1) = "." Or Mid(cell, i, 1) = ",") Then
With cell.Characters(Start:=i, Length:=1).Font
.Superscript = True
' .Bold = True
End With
End If
Next i
If Not (IsNumeric(cell)) Then
With cell.Characters.Font
' .Bold = True
.FontStyle = "Bold"
End With
End If
End If
Next cell

End Sub