×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Excel VBA Subscript/Superscript Macro

Excel VBA Subscript/Superscript Macro

Excel VBA 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]

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

Hope this helps.

RE: Excel VBA Subscript/Superscript Macro

This appears to be a duplicate post - see thread770-138208. Cross-posting is generally discouraged in these forums

Good Luck
johnwm
________________________________________________________
To get the best from these forums read FAQ731-376 before posting

Steam Engine enthusiasts: www.essexsteam.co.uk

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources