Formatting a character in a particular position of a string

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 H₂O 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!

Code:

---

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

---