Sub/Super-scripting Macro

[IvenBach]

I am trying to create a macro that will sub/superscript respectively when surrounded by "_" or "^". I have tried a few ways but haven't used VBA for a while and need some help. Below is the code that works if only subscript or superscript is needed but not when both need to be performed. Will I have to replace the split and join with another method when both need to be performed?

Sub Super_and_Subscript()
    S_Script ("^")
    S_Script ("_")
End Sub


Sub S_Script(Symbol As String)
Dim i As Integer
'
' Macro1 Macro
'
Dim temp() As String
Dim rngSTART As Range, r As Range
Dim sngSTART!, sngLEN!


On Error GoTo HANDLERR


    For Each r In Selection
        Set rngSTART = r


        'If Right(rngSTART.Value, 1) <> Symbol Then rngSTART.Value = rngSTART.Value & Symbol
        temp() = Split(r, Symbol)
        rngSTART.Value2 = Join(temp(), "")
        
        sngSTART = 1
        
        For i = 0 To UBound(temp()) Step 2
            Select Case True
            Case Len(temp(i + 1)) > 0
                sngSTART = Len(temp(i)) + 0 + sngSTART + sngLEN
                sngLEN = Len(temp(i + 1))
                'need to update to the current position & length
                Select Case True
                    Case Symbol = "^"
                        rngSTART.Characters(sngSTART, sngLEN).Font.Superscript = True
                    Case Symbol = "_"
                        rngSTART.Characters(sngSTART, sngLEN).Font.Subscript = True
                End Select
            End Select
        Next
        sngSTART = 0
        sngLEN = 0
    Next
    Exit Sub
HANDLERR:
End Sub

 

[Scott Huish]

Can you give us a sample of your data?

Do you actually need to select your data first or is there a range we can specify in the code?

 

[IvenBach]

I will be selecting the data that I want each time.

The text will be something like 'P_1_*T_1_^2^-P_2_*T_2_^2^' where anything surrounded by _Example_ will be subscripted or ^Example^ will be superscripted, where example is just any text. It won't always be the numbers that need to be sub/superscripted either. Sometimes it'll be a single letter or it can be an entire word.

 

[Scott Huish]

Do you want the characters _ and ^ removed from the text after it changes them to superscript and subscript?

 

[IvenBach]

Yes. I only have them there as an indication that whatever is sandwhiched between is what needs to be sub/superscripted.

 

[shg]

Minimally tested:

Sub Main()
  With ActiveWindow.RangeSelection
    SupSub .Cells, True, "^", "^"
    SupSub .Cells, False, "_", "_"
  End With
  
  ' this string gets ugly results in Excel 2010: "^1^ab_23_nn^34^"
End Sub

Sub SupSub(ByVal rInp As Range, bSup As Boolean, _
           ByVal sOpn As String, ByVal sCls As String)
  ' shg 2015

  ' Subscripts or superscripts characters bracketed by open and closing
  ' braces. Nesting is not supported.

  ' Open and closing braces can be the same (e.g., _x_) or different
  ' (e.g., "/x\"), but testing for balance is more rigorous if they are
  ' different.

  ' Cells containing unbalanced braces are highlighted. Nested braces are
  ' considered unbalanced.

  Dim rFind         As Range
  Dim sInp          As String
  Dim dic           As Object   ' keeps track of unbalanced strings
  Dim bOn           As Boolean
  Dim i             As Long

  Set dic = CreateObject("Scripting.Dictionary")
  Set rInp = rInp.SpecialCells(xlCellTypeConstants, xlTextValues)

  Set rFind = rInp.Find(What:=sOpn, LookIn:=xlValues, LookAt:=xlPart)
  Application.ScreenUpdating = False

  Do While Not rFind Is Nothing
    With rFind
      sInp = .Text
      If IsBalanced(sInp, sOpn, sCls) Then
        bOn = False
        For i = Len(sInp) To 1 Step -1
          Select Case Mid(sInp, i, 1)
            Case sOpn, sCls
              bOn = Not bOn
              .Characters(i, 1).Delete
            Case Else
              If bOn Then
                If bSup Then
                  .Characters(i, 1).Font.Superscript = True
                Else
                  .Characters(i, 1).Font.Subscript = True
                End If
              End If
          End Select
        Next i

      Else
        If dic.exists(.Address) Then Exit Do
        dic.Add Key:=.Address, Item:=0&
        .Interior.Color = vbYellow
      End If
    End With

    Set rFind = rInp.FindNext(rFind)
  Loop

  Application.ScreenUpdating = True
End Sub

Function IsBalanced(sInp As String, sOpn As String, sCls As String) As Boolean
  ' returns True if sInp has balanced opening and closing braces

  Dim i             As Long
  Dim n             As Long

  If sOpn = sCls Then
    IsBalanced = (Len(sInp) - Len(Replace(sInp, sOpn, ""))) Mod 2 = 0

  Else
    For i = 1 To Len(sInp)
      Select Case Mid(sInp, i, 1)
        Case sOpn
          n = n + 1
          If n > 1 Then Exit For
        Case sCls
          n = n - 1
          If n < 0 Then Exit For
      End Select
    Next i
    IsBalanced = n = 0
  End If
End Function

 

[IvenBach]

Thank you. I have gone through the macro a couple times now and have a couple questions.

1. Within Sub Main() RangeSelection is used. I've not seen this before and didn't know this range object existed. This alone was worth the help I've received.
2. When calling SupSub the inputs aren't in the form SupSub(input1, input2, input3, ...) as I've normally seen it. Is there any difference or reason not to set it up in this format or just your preference?
3. I didn't know Dictionary objects were available. I read through VBA for smarties: Dictionaries and it gave me a brief understanding (up to section IV) of what the dictionary object is. Is there any reading that you'd suggest to learn more about them? Why is Item equal to 0&. That was something I wasn't able to understand.
4. When using 'Set rFind = ....' that only returns the range objects with the sOpn (ie "^" or "_"). Eliminating looping through cells that don't need the SupSubcripting performed.
5. The code below, while quite elegant, is difficult for me to clearly see. If you'd indulge my explanation and let me know if I've understood it correctly. each character of the sInp is compared with the Case to both sOpn, sCls as an OR() and when either is True the code executes. bOn becomes True (since booleans are initialized as false?) and deletes the character. It continues through the string activating Case Else. The Else portion activates the Sup/Subscript respectively for each character until it reaches the sOpn or sCls character which then turns off bOn and deletes the character and continues on.

bOn = False
        For i = Len(sInp) To 1 Step -1
          Select Case Mid(sInp, i, 1)
            Case sOpn, sCls
              bOn = Not bOn
              .Characters(i, 1).Delete
            Case Else
              If bOn Then
                If bSup Then
                  .Characters(i, 1).Font.Superscript = True
                Else
                  .Characters(i, 1).Font.Subscript = True
                End If
              End If
          End Select
        Next i

This is a lot more elegant solution than I'd have come up with. It's also exposed me to a couple things that are very beneficial for me too. Thank you again for this and taking the time to read through helping me understand.

 

[Rick Rothstein]

I believe this somewhat compact macro will also work (simply select the cells you want to process and run it)...

Sub SubSuperScripting()
  Dim X As Long, Position As Long, Cell As Range, V As Variant, SubSuper() As String
  For Each Cell In Selection
    For Each V In Array("_", "^")
      SubSuper = Split(Cell.Value, V)
      For X = 1 To UBound(SubSuper) Step 2
        Position = InStr(Cell.Value, V & SubSuper(X) & V)
        Cell.Characters(Position, Len(SubSuper(X)) + 2).Text = SubSuper(X)
        With Cell.Characters(Position, Len(SubSuper(X))).Font
          If V = "_" Then .SubScript = True Else .SuperScript = True
        End With
      Next
    Next
  Next
End Sub

 

[shg]

1. ...

2. If you use the Call keyword, then you need to use the parens. For lots more detail, read through the thread at http://www.mrexcel.com/forum/excel-questions/843741-passing-global-variables-value.html

3. Each entry in a dictionary comprises a Key and an Item. Here, all we need is a Key, but Item is mandatory -- so zero is as good as anything else. The ampersand just makes it a Long.

4. ...

5. Since the code deletes characters, it iterates through the string back to front so the character position stays in sync with the loop counter. It toggles the subscripting on/off as it encounters each opening or closing character (which are known to be balanced by prior test).

 

[Rick Rothstein]

I see shg marked improperly formed cell values in yellow in his code... here is my code, modified to do the same thing:

Sub SubSuperScripting()
  Dim X As Long, Position As Long, Cell As Range, V As Variant
  Dim Original As String, SubSuper() As String
  For Each Cell In Selection
    Original = Cell.Value
    For Each V In Array("_", "^")
      SubSuper = Split(Cell.Value, V)
      For X = 1 To UBound(SubSuper) Step 2
        If (V = "_" And SubSuper(X) Like "*^*") Or _
           (V = "^" And SubSuper(X) Like "*_*") Then
          Cell.Interior.ColorIndex = 6
          Cell.Value = Original
          Exit For
        Else
          Position = InStr(Cell.Value, V & SubSuper(X) & V)
          Cell.Characters(Position, Len(SubSuper(X)) + 2).Text = SubSuper(X)
          With Cell.Characters(Position, Len(SubSuper(X))).Font
            If V = "_" Then .SubScript = True Else .SuperScript = True
          End With
        End If
      Next
      If Cell.Value = Original Then Exit For
    Next
  Next
End Sub