Hi,
Right now, the fastest way I've found to superscript part of text
within a cell is a 5 step process. I'm looking for a faster way?
The vast majority of times, the superscript will be the first or last
letter of a cell (for footnoting), but there are also times when
scientific compounds are seen in cells with superscripting or
subscripting, so it's not always the first/last character.
Here are the steps I currently use to do this:
- Select the cell
- Select the text in the formula bar that I need superscripted
- Right click and select Format Cells
- Select Superscript
- Click OK
What if I encapsulated that which I wanted superscripted or
subscripted? For example, my text in a cell might read '[a]Group
means are shown.' Then a worksheet event or some other macro could
process everything within the brackets to superscript (or use {} for
subscripting). I think something like that might work, wouldn't it?
Would this be able to be done with a Worksheet.Change event?
Thanks.
Frank
Here's one way, using a worksheet change event.
Because it was simpler than deleting them, to make them "invisible", I set the font size of the "encapsulating symbols" to one (1), the minimum. You could also make them the same color as the background, although this might result in inappropriate spacing. But be aware that merely changing format characteristics of a cell will not trigger the worksheet change event, so you may get funny results.
To enter this event-triggered Macro, right click on the sheet tab.
Select "View Code" from the right-click drop-down menu.
Then paste the code below into the window that opens.
=====================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sEncapsule(0 To 1) As String
Dim StartSS As Long, LenSS As Long
Dim re As Object, mc As Object, m As Object
Dim i As Long
Application.EnableEvents = False
sEncapsule(0) = "[": sEncapsule(1) = "]"
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[" & sEncapsule(0) & "][^" & sEncapsule(1) & "]+[" & sEncapsule(1) & "]"
If Not Target.HasFormula Then
Set mc = re.Execute(Target.Text)
For Each m In mc
Target.Characters(m.firstindex + 1, m.Length).Font.Superscript = True
Target.Characters(m.firstindex + 1, 1).Font.Size = 1
Target.Characters(m.firstindex + m.Length, 1).Font.Size = 1
Next m
End If
Application.EnableEvents = True
End Sub
==================================
Hi and thanks! I did some more searching online during lunch today
and came across the code below which works absolutely great! I placed
it in the Worksheet_Change event also, and all I have to do is enter a
^ (shift 6) character before the letter i want to superscript or a |
(shift back slash) before the letter I want to subscript. Once I hit
enter, my letter is formatted appropriately. Now, this only works
with a single character, and there are occassions where I need
multiple letters super/sub-scripted, but the vast majority of times is
simply one character, so I can use the tried and true old fashioned
way for those other occassions. I appreciate your help, and your code
and the other I found that I'm posting below will hopefully help
others. Thanks!
Private Const CHAR_SUP As String = "^"
Private Const CHAR_SUB As String = "|"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If IsNumeric(Target.Value) Then Exit Sub
'Look for SUPERSCRIPT character
If InStr(1, Target.Value, CHAR_SUP) > 0 Then
SuperScript Target, InStr(1, Target.Value, CHAR_SUP)
End If
'Look for SUBSCRIPT character
If InStr(1, Target.Value, CHAR_SUB) > 0 Then
SubScript Target, InStr(1, Target.Value, CHAR_SUB)
End If
End Sub
Private Function LeftString(ByVal sText As String, ByVal sSeparator As
String) As String
LeftString = Left(sText, InStr(1, sText, sSeparator) - 1)
End Function
Private Function RightString(ByVal sText As String, ByVal sSeparator
As String) As String
RightString = Right(sText, Len(sText) - InStr(1, sText, sSeparator))
End Function
Private Sub SuperScript(ByVal Target As Range, ByVal iPosition As
Integer)
Target.Value = LeftString(Target.Value, CHAR_SUP) &
RightString(Target.Value, CHAR_SUP)
Target.Characters(Start:=iPosition, Length:=1).Font.SuperScript =
True
End Sub
Private Sub SubScript(ByVal Target As Range, ByVal iPosition As
Integer)
Target.Value = LeftString(Target.Value, CHAR_SUB) &
RightString(Target.Value, CHAR_SUB)
Target.Characters(Start:=iPosition, Length:=1).Font.SubScript =
True
End Sub
