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.

    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
                                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