VBA - How to subscript?

I'm replacing a character with another and then subscripting that new
character. My code seems to work fine except when the object has
multiple paragraphs. The last routine below (SubScriptMe) is called to
subscript, but with multiple paragraphs it's counting the paragraph
marker and screwing up the count to subscript the correct character.
argh!

Is there a better way to accomplish this? Or is there a way to work
around multiple paragraphs.

Thanks,
Melina
(code below)

Sub SearchReplaceSubscript()
Dim oSld As Slide
Dim oShp As Shape
Dim sSearchFor As String
Dim sReplaceWith As String
sSearchFor = ChrW$(8482)
sReplaceWith = ChrW$(9674)

For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
Call SearchReplace(oShp, sSearchFor, sReplaceWith)
Next oShp
Next oSld
End Sub

Sub SearchReplace(oShp As Object, sSearchFor As String, sReplaceWith
As String)
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Dim iCntr As Integer
Dim iRow As Integer
Dim iCol As Integer
Dim oShpTmp As Shape

On Error Resume Next
Select Case oShp.Type

Case 19
For iRow = 1 To oShp.Table.Rows.Count
For iCol = 1 To oShp.Table.Rows(iRow).Cells.Count
Set oTxtRng = oShp.Table.Rows(iRow).Cells
(iCol).Shape.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:=sSearchFor, _
Replacewhat:=sReplaceWith, WholeWords:=False)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=sSearchFor, _
Replacewhat:=sReplaceWith, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=False)
Call SubScriptMe(oTxtRng, sReplaceWith)
Loop
Next
Next

Case msoGroup
For iCntr = 1 To oShp.GroupItems.Count
Call SearchReplace(oShp.GroupItems(iCntr), sSearchFor,
sReplaceWith)
Next iCntr

Case 21
For iCntr = 1 To oShp.Diagram.Nodes.Count
Call SearchReplace(oShp.Diagram.Nodes(iCntr).TextShape,
sSearchFor, sReplaceWith)
Next iCntr

Case Else
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Set oTxtRng = oShp.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:=sSearchFor, _
Replacewhat:=sReplaceWith, WholeWords:=False)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=sSearchFor, _
Replacewhat:=sReplaceWith, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=False)
Loop
Call SubScriptMe(oTxtRng, sReplaceWith)
End If
End If

End Select
End Sub

Sub SubScriptMe(oTxtRng As TextRange, sReplaceWith As String)
Dim iPos As Long
iPos = InStr(oTxtRng, sReplaceWith)
Do While iPos 0
oTxtRng.Characters(iPos, 1).Font.SuperScript = True
iPos = InStr(iPos + 1, oTxtRng, sReplaceWith)
Loop
End Sub