Option Explicit

Sub HighlightKeywords()
'https://stackoverflow.com/questions/15844903/find-and-highlight-text-in-ms-powerpoint
    Dim sld As Slide
    Dim shp As Shape
    Dim txtRng As TextRange, rngFound As TextRange
    Dim i As Long, n As Long
    Dim TargetList
    TargetList = Array(" ", "^p") '~~>  Array of terms to search for
    For Each sld In Application.ActivePresentation.Slides  '~~> Loop through each slide
        For Each shp In sld.Shapes  '~~> Loop through each shape
            If shp.HasTextFrame Then '~~> Check if it has text
                Set txtRng = shp.TextFrame.TextRange
                    For i = 0 To UBound(TargetList)
                    Set rngFound = txtRng.Find(TargetList(i)) '~~> Find the text
                    Do While Not rngFound Is Nothing '~~~> If found
                        n = rngFound.Start + 1 '~~> Set the marker so that the next find starts from here
                            If rngFound.Font.Bold = msoTrue And rngFound.Font.Color = vbRed Then
                            rngFound.Font2.Highlight.RGB = RGB(255, 255, 0) 'yellow
                            End If
                        Set rngFound = txtRng.Find(TargetList(i), n) '~~> Find Next instance
                    Loop
                    Next
            End If
        Next
    Next
    MsgBox "Done"
End Sub

Sub FindReplaceAll()
'PURPOSE: Find & Replace text/values throughout entire PowerPoint presentation
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sld As Slide
Dim shp As Shape
Dim ShpTxt As TextRange
Dim TmpTxt As TextRange
Dim FindWord As Variant
Dim ReplaceWord As Variant

FindWord = " "
ReplaceWord = "@"

'Loop through each slide in Presentation
  For Each sld In ActivePresentation.Slides
    
    For Each shp In sld.Shapes
    If shp.HasTextFrame Then
      'Store shape text into a variable
        Set ShpTxt = shp.TextFrame.TextRange
      
      'Ensure There is Text To Search Through
        If ShpTxt <> "" Then
  If ShpTxt.Font.Bold = msoTrue And oTxtRng.Font.Color = vbRed Then
          'Store text into a variable
            Set ShpTxt = shp.TextFrame.TextRange
          
          'Find First Instance of "Find" word (if exists)
            Set TmpTxt = ShpTxt.Replace( _
             FindWhat:=FindWord, _
             Replacewhat:=ReplaceWord, _
             WholeWords:=True)
      
          'Find Any Additional instances of "Find" word (if exists)
            Do While Not TmpTxt Is Nothing
              Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
              
              Set TmpTxt = ShpTxt.Replace( _
               FindWhat:=FindWord, _
               Replacewhat:=ReplaceWord, _
               WholeWords:=True)
            Loop
          End If
        End If
        End If
    Next shp
      
  Next sld
MsgBox "Done"
End Sub

Sub killRed()
   Dim otr As TextRange
   Dim oshp As Shape
   Dim L As Long
   Dim C As Long
   Dim osld As Slide
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If oshp.HasTextFrame Then
            If oshp.TextFrame.HasText Then
               For L = oshp.TextFrame.TextRange.Paragraphs.Count To 1 Step -1
                  Set otr = oshp.TextFrame.TextRange.Paragraphs(L)
                  For C = otr.Characters.Count To 1 Step -1
                     If Asc(otr.Characters(C)) = 32 Or Asc(otr.Characters(C)) = 13 Then
                        If otr.Characters(C).Font.Color = vbRed And otr.Characters(C).Font.Bold = True Then
                           'otr.Characters(C) = "@" optional
                           'delete this to change to @
                           '''''''''''''''''''
                           otr.Characters(C).Font.Bold = False
                           otr.Characters(C).Font.Color = vbBlack
                           ''''''''''''''''''''
                        End If
                     End If
                  Next C
               Next L
            End If
            End If
         Next oshp
      Next osld
End Sub