Formatting a part of the text in tables

[moomphas]

Hi,

I'm trying to figure out how to write a code that looks for "ABC" in tables and changes it to "ABC" (so just makes it bold). I found a code that works with shapes:

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

Does anyone have an idea how to change it so that it works for tables?

[John Wilson]

Try this:


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
Dim irow As Integer
Dim icol As Integer
'~~> 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 is a table
If shp.HasTable Then
For irow = 1 To shp.Table.Rows.Count
For icol = 1 To shp.Table.Columns.Count
Set txtRng = shp.Table.Cell(irow, icol).Shape.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 i
Next icol
Next irow
End If
Next
Next
End Sub

[moomphas]

Thank you very much! It works! :)