Hi all.

I have some code that allows me to search for some text and then apply superscript or subscript formatting (or apply neither). This was to get round PowerPoint lacking Word's find and replace functionality that allows you to change formatting throughout. I have largely just mashed together code I have found in other places to make this work, so I'm not claiming credit for this code!

What would be really useful is if the code could find a specified string and then apply formatting to a specific character within it. As a basic example, if I have H2O written throughout the deck, changing all 2s in the deck to subscript is probably not ideal. I just want 2s in H2O to be subscript.

So, I would really appreciate help changing the code below to search for a given string (such as H2O) then apply the chosen formatting to only the character at a specified position (position 2, in this case).

If anyone can help, I'd be super grateful. Like I say, I've cobbled together this code from a couple of different places so it is a) probably very clunky and b) not my own work for the most part; I claim no credit!

Sub Super_Or_Sub()
Dim oshp As Shape
   Dim osld As Slide
   Dim oTMP As TextRange
   Dim lngPos As Long
   Dim strResult As String
   Dim strFormat As String
    strResult = InputBox("Text to change")
    strFormat = InputBox("Font format: Super, sub or none?")


If strFormat = "Super" Then
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
                Set txtRng = oshp.TextFrame.TextRange
                Set foundText = txtRng.Find(FindWhat:=strResult)


                Do While Not (foundText Is Nothing)
                With foundText
                    .Font.Superscript = True
                    Set foundText = _
                        txtRng.Find(FindWhat:=strResult, _
                        After:=.Start + .Length - 1)
                End With
                Loop
            End If
         End If
      Next oshp
   Next osld


Else
   If strFormat = "super" Then
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
                Set txtRng = oshp.TextFrame.TextRange
                Set foundText = txtRng.Find(FindWhat:=strResult)


                Do While Not (foundText Is Nothing)
                With foundText
                    .Font.Superscript = True
                    Set foundText = _
                        txtRng.Find(FindWhat:=strResult, _
                        After:=.Start + .Length - 1)
                End With
                Loop
            End If
         End If
      Next oshp
   Next osld


Else
   If strFormat = "Sub" Then
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
                Set txtRng = oshp.TextFrame.TextRange
                Set foundText = txtRng.Find(FindWhat:=strResult)


                Do While Not (foundText Is Nothing)
                With foundText
                    .Font.Subscript = True
                    Set foundText = _
                        txtRng.Find(FindWhat:=strResult, _
                        After:=.Start + .Length - 1)
                End With
                Loop
            End If
         End If
      Next oshp
   Next osld


Else
   If strFormat = "sub" Then
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
                Set txtRng = oshp.TextFrame.TextRange
                Set foundText = txtRng.Find(FindWhat:=strResult)


                Do While Not (foundText Is Nothing)
                With foundText
                    .Font.Subscript = True
                    Set foundText = _
                        txtRng.Find(FindWhat:=strResult, _
                        After:=.Start + .Length - 1)
                End With
                Loop
            End If
         End If
      Next oshp
   Next osld
   
Else
   If strFormat = "None" Then
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
                Set txtRng = oshp.TextFrame.TextRange
                Set foundText = txtRng.Find(FindWhat:=strResult)


                Do While Not (foundText Is Nothing)
                With foundText
                    .Font.Subscript = False
                    .Font.Superscript = False
                    Set foundText = _
                        txtRng.Find(FindWhat:=strResult, _
                        After:=.Start + .Length - 1)
                End With
                Loop
            End If
         End If
      Next oshp
   Next osld
   
Else
   If strFormat = "none" Then
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
                Set txtRng = oshp.TextFrame.TextRange
                Set foundText = txtRng.Find(FindWhat:=strResult)


                Do While Not (foundText Is Nothing)
                With foundText
                    .Font.Subscript = False
                    .Font.Superscript = False
                    Set foundText = _
                        txtRng.Find(FindWhat:=strResult, _
                        After:=.Start + .Length - 1)
                End With
                Loop
            End If
         End If
      Next oshp
   Next osld
   
End If
End If
End If
End If
End If
End If


End Sub