Find and Highlight Text in MS PowerPoint

Question

I used some code from this site to make a macro to do a keyword search on Word docs and highlight the results.

I would like to replicate the effect in PowerPoint.

Here is my code for Word.

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

Here is what I have so far in PowerPoint, it is in no way functional.

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

---

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.

Here is the code I went with:

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

---

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.

Solution 1

AFAIK there is no inbuilt way to highlight the found word with a color. You could go out of the way to create a rectangular shape and place it behind the found text and color it but that is a different ball game altogether.

Here is an example which will search for the text in all slides and then make the found text BOLD, UNDERLINE and ITALICIZED. If you want you can also change the color of the font.

Let's say we have a slide which looks like this

Paste this code in a module and then try it. I have commented the code so that you will not have a problem understanding it.

Option Explicit

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("keyword", "second", "third", "etc")

    '~~> 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
                        '~~> Chnage 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

Final Screenshot

Solution 2

I'd like to extend @Siddharth Rout answer which is good and rather recommended (awarder +1 from me). However, there is possibility to 'highlight' a word (range of words) in PP, too. There is one serious disadvantage of setting highlight- it destroys other font settings. Therefore, if one really need to use highlight than we need to return appropriate font settings afterwards.

Here is an example for single word in single text frame:

Sub Highlight_Word()

Dim startSize, startFont, startColor

With ActivePresentation.Slides(1).Shapes(1).TextFrame2.TextRange.Words(8).Font
'read current state
   startSize = .Size
   startFont = .Name
   startColor = .Fill.ForeColor.RGB

'set highlight
   .Highlight.RGB = RGB(223, 223, 223) 'light grey

'return standard parameters
   .Size = startSize
   .Name = startFont
   .Fill.ForeColor.RGB = startColor

End With

End Sub

That kind of solution could be placed somewhere inside of @Siddharth solution.

Comments

[Ryan Solis]

That looks pretty close to what I came up with, so I think I'm on the right path. Thanks for the help!

[Ryan Solis]

Good to know that highlighting is technically possible. Thank you for the input.

[Ryan Solis]

Wow, I wish I had the rep to give you another +1. I compiled your code just for fun and holy crap, it runs ten times as fast as mine. I guess that's the difference between your for loop that iterates through the list looking for each word in every text box nested and my iterative for loop searching the whole presentation for one word, then searching the whole presentation again for the next word. Thanks again, I learned a lot about efficiency through your example. -Ryan

[Ryan Solis]

The ".Highlight.RGB =" line gave me this error: Compile error: Method or data member not found

[Steve Rindsberg]

Pretty sure you'd need to be running PPT 2010 (or maybe 2007) or higher to use .Highlight

[Siddharth Rout]

+ 1 :) KJ. Yes there IS a possibility of highlighting text like I mentioned in my post but there is no INBUILT way like MS Word that I am aware of...

[Kazimierz Jawor]

@Ryan, @Steve, tested in PP2010 only. I need to admit that .Highlight is poorly described in PP help- use intuition when using :)

[OfficeAddinDev]

This is basically the approach I use, except what I found (in PowerPoint 2013, anyway) is that the Find() function does not necessarily return Nothing when no matches are found, and may return an empty TextRange object instead. This seems like a PowerPoint bug. Therefore, my workaround code is equivalent to Do While Not rngFound Is Nothing AndAlso rngFound.Length > 0.