macro de palabras para resaltar conjuntos de palabras en diferentes colores

Tengo una macro de Word que personalicé hace un tiempo de otra persona (desafortunadamente no puedo encontrar la fuente). El propósito es resaltar todas las ocurrencias de "él" y "su" en turquesa, y todas las ocurrencias de "ella" y "ella" en rosa. Funciona parcialmente: resalta "él" (pero no "su") en turquesa y "ella" (pero no "ella") en rosa.

¿Qué estoy haciendo mal?

Sub HighLightHeShe()
    Dim vFindText As Variant
    Dim oRng As Range
    Dim i As Long
    vFindText = Array("he", "his")
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While .Execute(FindText:=vFindText(i), _
                          MatchWholeWord:=True, _
                          Forward:=True, _
                          Wrap:=wdFindStop) = True
            oRng.HighlightColorIndex = wdTurquoise
            oRng.Collapse wdCollapseEnd
        Loop
    End With
    vFindText = Array("she", "her")
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While .Execute(FindText:=vFindText(i), _
                          MatchWholeWord:=True, _
                          Forward:=True, _
                          Wrap:=wdFindStop) = True
            oRng.HighlightColorIndex = wdPink
            oRng.Collapse wdCollapseEnd
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub

La razón por la que solo encuentra el primer elemento en cada matriz es porque no está cambiando el valor de "i". Necesita envolver los "hallazgos" en un bucle.

Vea abajo ...

Sub HighLightHeShe()
    Dim vFindText As Variant
    Dim oRng As Range
    Dim i As Long

    vFindText = Array("he", "his")
    For i = 0 To UBound(vFindText)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(FindText:=vFindText(i), _
                              MatchWholeWord:=True, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
                oRng.HighlightColorIndex = wdTurquoise
                oRng.Collapse wdCollapseEnd
            Loop
        End With
    Next

    vFindText = Array("she", "her")
    For i = 0 To UBound(vFindText)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(FindText:=vFindText(i), _
                              MatchWholeWord:=True, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
                oRng.HighlightColorIndex = wdPink
                oRng.Collapse wdCollapseEnd
            Loop
        End With
    Next

lbl_Exit:
    Exit Sub
End Sub