Excel Subscript/Superscript Macro 3

[PEStructural]

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]

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

Hope this helps.

 

[bltseattle]

I too got fed up with Excel's limitations in this regard. I found a macro on-line that I use for the same effect. Instead of processing special format characters when it is run, this one pulls open a dialogue with the text of the current cell and 3 buttons: Super, Sub, and Normal. You then highlight each character you want to change and hit the button. If you google "Creating Superscript and Subscript Buttons" you can find it.

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!

 

[PEStructural]

I also found a nice freeware online called JWalk SuperSub. It does the same thing that we're talking about.

 

[vooter]

Holy cow, PEStrcutural! That's an AMAZING add-in!

I got it from here:

http://www.j-walk.com/ss/excel/files/supersub.htm

Wow!

 

[PEStructural]

Here is another procedure that does the same thing. This requires that you create your own Add-In. I did this and also created a custom button for the macro and placed it in my toolbar. On this website, it has an image that you can copy/paste onto an excel spreadsheet. Then you select the object and make the object have "No Fill". Then you can copy the image and place a new button in the toolbar and replace the default image with the copied image. This one works nices too and it has the option for symbols as well.

http://vertex42.com/ExcelTips/excel-toolbar-buttons.html

 

[bltseattle]

PEStructural
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

 

[PEStructural]

Thanks for the input. Here is the modified version that takes care of both those issues:

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, "{", ""))
'
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!

 

[broekie]

This is a pretty cool macro, which is way beyond my ability to write, but is it really any quicker than just highlighting the text you want to change and clicking Format / Cell / Font / Superscript. Doesn't really seem like I am saving many mouse clicks.

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?

 

[PEStructural]

Broekie,

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.

 

[broekie]

I appreciate the effort and the knowledge, PEStructural. I'll use your suggestion. Thank you.

 

[bltseattle]

PEStructural,
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.

 

[krossview]

bltseattle

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 and does save time plus works for both full and partial selected cell text.


Krossview