Find and Replace for all instances of "Find" list

[goreeans]

I am trying to run a find/replace using arrays, and it works, but only for the first instances on each slide. I have a slide title with duplicate words, but only the first is replaced, so I'm hoping for some help to get both words replaced.
Thanks!

    'LOOP THROUGH EACH SLIDE
    For Each sld In objPPT.ActivePresentation.Slides
        For Y = LBound(FindArray1) To UBound(FindArray1)
            fnd = FindArray1(Y)
            rplc = ReplaceArray1(Y)
            For Each shp In sld.Shapes
                If shp.HasTextFrame Then
                    If shp.TextFrame.HasText Then
                        Set TxtRng = shp.TextFrame.TextRange.Find(fnd, 0, True, WholeWords:=msoTrue)
                        If Not TxtRng Is Nothing Then
                            Do
                                Set tmprng = TxtRng.Replace(FindWhat:=fnd, ReplaceWhat:=rplc, WholeWords:=True, MatchCase:=True)
                            Loop While Not tmprng Is Nothing
                        End If
                    End If
                End If
            Next shp
        Next Y
    Next sld

Thanks for sharing it with us!