Excel Subscript/Superscript Macro
Excel Subscript/Superscript Macro
(OP)
All,
I wrote this VB code for automatically subscripting/superscripting text. I find it very cumbersome to subscript and superscript text in excel. The following macro requires that you put brackets [] around anything you want subscripted and tildes {} around anything you want superscripted.
An example would be:
D[col] + x{2} + C[1] + Y[base]
Hope this helps.
I wrote this VB code for automatically subscripting/superscripting text. I find it very cumbersome to subscript and superscript text in excel. The following macro requires that you put brackets [] around anything you want subscripted and tildes {} around anything you want superscripted.
An example would be:
D[col] + x{2} + C[1] + Y[base]
CODE
Sub Super_Sub()
Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub
Dim CounterSub
Dim CheckSuper
Dim CounterSuper
Dim Cell
'
CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
Cell = ActiveCell
'
NumSub = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "[", ""))
NumSuper = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "{", ""))
'
Do
Do While CounterSub <= 1000
SubL = Application.WorksheetFunction.Find("[", ActiveCell, 1)
SubR = Application.WorksheetFunction.Find("]", ActiveCell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
'
'
Do
Do While CounterSuper <= 1000
SuperL = Application.WorksheetFunction.Find("{", ActiveCell, 1)
SuperR = Application.WorksheetFunction.Find("}", ActiveCell, 1)
ActiveCell.Characters(SuperL, 1).Delete
ActiveCell.Characters(SuperR - 1, 1).Delete
ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
CounterSuper = CounterSuper + 1
If CounterSuper = NumSuper Then
CheckSuper = False
Exit Do
End If
Loop
Loop Until CheckSuper = False
'
End Sub
Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub
Dim CounterSub
Dim CheckSuper
Dim CounterSuper
Dim Cell
'
CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
Cell = ActiveCell
'
NumSub = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "[", ""))
NumSuper = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "{", ""))
'
Do
Do While CounterSub <= 1000
SubL = Application.WorksheetFunction.Find("[", ActiveCell, 1)
SubR = Application.WorksheetFunction.Find("]", ActiveCell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
'
'
Do
Do While CounterSuper <= 1000
SuperL = Application.WorksheetFunction.Find("{", ActiveCell, 1)
SuperR = Application.WorksheetFunction.Find("}", ActiveCell, 1)
ActiveCell.Characters(SuperL, 1).Delete
ActiveCell.Characters(SuperR - 1, 1).Delete
ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
CounterSuper = CounterSuper + 1
If CounterSuper = NumSuper Then
CheckSuper = False
Exit Do
End If
Loop
Loop Until CheckSuper = False
'
End Sub
Hope this helps.





RE: Excel Subscript/Superscript Macro
Good topic, I wonder if Microsoft will ever address these limitations we keep discussing in this forum..... I definitely believe that the MS programmers must not use super or subscripts in excel or this would have been fixed years ago!
RE: Excel Subscript/Superscript Macro
RE: Excel Subscript/Superscript Macro
I got it from here: http://www.j-walk.com/ss/excel/files/supersub.htm
Wow!
RE: Excel Subscript/Superscript Macro
http:/
RE: Excel Subscript/Superscript Macro
I find your original macro works great if there are both supers and subs but crashes if one or the other is missing or if the cell is blank. The latter can be fixed by adding "IF LEN(CELL)=0 THEN EXIT SUB" but I'm still looking at how to fix the other cases. I like that your macro doesn't require a separate pop-up - this can save time. I dont' like that the J-WALK requires using an add-in; I'd rather have the code to add to my personal.xls template.
Cheers
BLTseattle
RE: Excel Subscript/Superscript Macro
CODE
Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub
Dim CounterSub
Dim CheckSuper
Dim CounterSuper
Dim Cell
'
CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
Cell = ActiveCell
'
NumSub = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "[", ""))
NumSuper = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "{", ""))
'
If Len(Cell) = 0 Then Exit Sub
If IsError(Application.Find("[", ActiveCell, 1)) = False Then
Do
Do While CounterSub <= 1000
SubL = Application.Find("[", ActiveCell, 1)
SubR = Application.Find("]", ActiveCell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
End If
'
'
If IsError(Application.Find("{", ActiveCell, 1)) = False Then
Do
Do While CounterSuper <= 1000
SuperL = Application.Find("{", ActiveCell, 1)
SuperR = Application.Find("}", ActiveCell, 1)
ActiveCell.Characters(SuperL, 1).Delete
ActiveCell.Characters(SuperR - 1, 1).Delete
ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
CounterSuper = CounterSuper + 1
If CounterSuper = NumSuper Then
CheckSuper = False
Exit Do
End If
Loop
Loop Until CheckSuper = False
End If
'
End Sub
Hope this works for you!
RE: Excel Subscript/Superscript Macro
I am not trying to rain on anyone's parade, just wanting to know if I am using the macro correctly or if I am missing something.
Also, what limitations is bltseattle referring to in regardsto subscripts and superscripts in Excel?
RE: Excel Subscript/Superscript Macro
It's just a preference I guess. I assigned the macro to Ctrl+Z so instead of having to get out of the cell and go to format>cells>subscript>OK, I just type the brackets or tildes while I'm typing and then hit Ctrl+Z. Just a preference that I wanted to share.
The limitations are compared to MS Word that actually have subscript and superscript buttons and keyboard shortcuts that are a lot faster than Excel.
I'm just trying to be a "sharer" of knowledge.
RE: Excel Subscript/Superscript Macro
RE: Excel Subscript/Superscript Macro
SWEET - this really works like a charm now. I setup a tool bar button that shows the two bracket types in the relative positions, so it is double-duty: runs the macro, and is a visual reminder of the syntax to use.
Broekie,
This macro is definitely faster if you have more than one super or sub script in a given cell, and if you've assigned this macro to a button or key-command. The problem is that Excel's formatting for super- sub-scripts is buried too deep in the menu system, and is impossible to assign to a tool bar button like the defaults for strike-thru, bold, italic, etc., which are operative as you are editing in the formula bar.
Consider that (Format>Cell>Font>check box) is 4 clicks per each super or sub script, vs. one click on a toolbar button to reformat all the supers or subs in a cell.
If you are using the menus (Tools>Macro>pick it>run = 4 clicks) to run the macro, however, it is unlikely to save you much time.
RE: Excel Subscript/Superscript Macro
You can cut down the 4 clicks to 1 click, if you use the keyboard shortcut "CTRL + 1", which brings up the "Format Cells" box. You may have to select the "Font" tab, which is 2 clicks, but you only have to do this once, if you repeat this often.
This shortcut is a keeper
Krossview