title: Find and Highlight Text in MS PowerPoint
body: <p>I used some code from this site to make a macro to do a keyword search on Word docs and highlight the results.  </p>
  
  <p>I would like to replicate the effect in PowerPoint.</p>
  
  <p>Here is my code for Word.</p>
  
  <pre><code>Sub HighlightKeywords()
  
  Dim range As range
  Dim i As Long
  Dim TargetList
  
  TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for
  
  For i = 0 To UBound(TargetList) ' for the length of the array
  
     Set range = ActiveDocument.range
  
     With range.Find ' find text withing the range "active document"
     .Text = TargetList(i) ' that has the words from the array TargetList
     .Format = True ' with the same format
     .MatchCase = False ' and is case insensitive
     .MatchWholeWord = True ' and is not part of a larger word
     .MatchAllWordForms = False ' and DO NOT search for all permutations of the word
  
     Do While .Execute(Forward:=True)
     range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow
  
     Loop
  
     End With
  Next
  
  End Sub
  </code></pre>
  
  <p>Here is what I have so far in PowerPoint, it is in no way functional.</p>
  
  <pre><code>Sub HighlightKeywords()
  
  Dim range As range
  Dim i As Long
  Dim TargetList
  
  TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for
  
  For Each sld In Application.ActivePresentation.Slides
  
  For Each shp In sld.Shapes
  
      If shp.HasTextFrame Then
  
          Set txtRng = shp.TextFrame.TextRange
  
  For i = 0 To UBound(TargetList) ' for the length of the array
  
     With range.txtRng ' find text withing the range "shape, text frame, text range"
     .Text = TargetList(i) ' that has the words from the array TargetList
     .Format = True ' with the same format
     .MatchCase = False ' and is case insensitive
     .MatchWholeWord = True ' and is not part of a larger word
     .MatchAllWordForms = False ' and DO NOT search for all permutations of the word
  
     Do While .Execute(Forward:=True)
     range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow
  
     Loop
  
     End With
  Next
  
  End Sub
  </code></pre>
  
  <hr>
  
  <p>I ended up finding my answer through the MSDN, but it was very close to the answer I selected as correct from what people submitted.</p>
  
  <p>Here is the code I went with:</p>
  
  <pre><code>Sub Keywords()
  
  Dim TargetList
  Dim element As Variant
  
  TargetList = Array("First", "Second", "Third", "Etc")
  
  For Each element In TargetList
     For Each sld In Application.ActivePresentation.Slides
        For Each shp In sld.Shapes
           If shp.HasTextFrame Then
              Set txtRng = shp.TextFrame.TextRange
              Set foundText = txtRng.Find(FindWhat:=element, MatchCase:=False, WholeWords:=True)
              Do While Not (foundText Is Nothing)
                 With foundText
                    .Font.Bold = True
                    .Font.Color.RGB = RGB(255, 0, 0)
                 End With
              Loop
           End If
        Next
     Next
  Next element
  
  End Sub
  </code></pre>
  
  <hr>
  
  <p>Turns out that code worked, but was a performance nightmare.  The code I selected as the correct answer below runs much more smoothly.  I've adjusted my program to match the answer selected.</p>