improved macro

can you improve this macro in order to ask which word to search ( only for one word would be ok) and when found change font color to  white  and same text box background invisible. That should work in PP

Sub HighlightKeywords()
    Dim sld As Slide
    Dim shp As Shape
    Dim txtRng As TextRange, rngFound As TextRange
    Dim i As Long, n As Long
    Dim TargetList

    '~~>  Array of terms to search for
    TargetList = Array("test")

    '~~> Loop through each slide
    For Each sld In Application.ActivePresentation.Slides
        '~~> Loop through each shape
        For Each shp In sld.Shapes
            '~~> Check if it has text
            If shp.HasTextFrame Then
                Set txtRng = shp.TextFrame.TextRange

                For i = 0 To UBound(TargetList)
                    '~~> Find the text
                    Set rngFound = txtRng.Find(TargetList(i))

                    '~~~> If found
                    Do While Not rngFound Is Nothing
                        '~~> Set the marker so that the next find starts from here
                        n = rngFound.Start + 1
                        '~~> Change attributes
                        With rngFound.Font
                            .Bold = msoTrue
                            .underline = msoTrue
                            .Italic = msoTrue
                            '~~> Find Next instance
                            Set rngFound = txtRng.Find(TargetList(i), n)
                        End With
                    Loop
                Next
            End If
        Next
    Next
End Sub

Thanks