does anyone know how to encode subscripts?

Sub Water()
    With ActiveCell
        .Value = "H2O"
        .Characters(Start:=2, Length:=1).Font.Subscript = True
    End With
End Sub

Sub SubSc()
    ' subscripts characters bracketed by /\
    Dim rFind       As Range
    Dim sAddr       As String
    Dim sInp        As String

    Dim ab()        As Boolean
    Dim b           As Boolean

    Dim sOut        As String
    Dim iRd         As Long
    Dim iWr         As Long

    Set rFind = Cells.Find(What:="/*\")
    If Not rFind Is Nothing Then
        sAddr = rFind.Address

        Do
            With rFind
                sInp = .Text
                If Balanced(sInp) Then
                    iWr = 0
                    sOut = Replace(Replace(sInp, "/", ""), "\", "")
                    ReDim ab(1 To Len(sOut))

                    For iRd = 1 To Len(sInp)
                        Select Case Mid(sInp, iRd, 1)
                            Case "/"
                                b = True
                            Case "\"
                                b = False
                            Case Else
                                iWr = iWr + 1
                                ab(iWr) = b
                        End Select
                    Next iRd
                Else
                    .Interior.Color = vbYellow
                End If

                .Value = sOut
                
                For iWr = 1 To Len(sOut)
                    If ab(iWr) Then .Characters(iWr, 1).Font.Subscript = True
                Next iWr
            End With

            Set rFind = Cells.FindNext(rFind)
            If rFind Is Nothing Then Exit Do
        Loop While rFind.Address <> sAddr
    End If
End Sub

Function Balanced(sInp As String) As Boolean
    ' returns True is sInp has balanced "/\"
    ' excercise left to user

    Balanced = True
End Function

Sub SubScr()
    ' subscripts characters bracketed by open and closing braces
    ' ignores nesting
    
    Const sOpn As String * 1 = "/"
    Const sCls As String * 1 = "\"
    
    Dim rFind       As Range
    Dim sAddr       As String
    Dim sInp        As String

    Dim ab()        As Boolean
    Dim b           As Boolean

    Dim sOut        As String
    Dim iRd         As Long
    Dim iWr         As Long

    Set rFind = Cells.Find(What:=sOpn, LookIn:=xlValues, LookAt:=xlPart)
    If Not rFind Is Nothing Then
        sAddr = rFind.Address

        Do
            With rFind
                sInp = .Text
                If IsBalanced(sInp, sOpn, sCls) Then
                    iWr = 0
                    sOut = Replace(Replace(sInp, sOpn, ""), sCls, "")
                    ReDim ab(1 To Len(sOut))

                    For iRd = 1 To Len(sInp)
                        Select Case Mid(sInp, iRd, 1)
                            Case sOpn
                                b = True
                            Case sCls
                                b = False
                            Case Else
                                iWr = iWr + 1
                                ab(iWr) = b
                        End Select
                    Next iRd

                    .Value = sOut

                    For iWr = 1 To Len(sOut)
                        If ab(iWr) Then .Characters(iWr, 1).Font.Subscript = True
                    Next iWr

                Else
                    .Interior.Color = vbYellow
                    sAddr = .Address
                End If
            End With

            Set rFind = Cells.FindNext(rFind)
            If rFind Is Nothing Then Exit Do
        Loop While rFind.Address <> sAddr
    End If
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

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

    IsBalanced = n = 0
End Function