VBA to conditionally edit slide titles?

I'd like to be able to run a script that will:

1. Loop through all slides
2. Look at the title placeholder (which is NOT always the first object on the slide, which I've learned may be problematic, code-wise) and determine the existence of 6 "target" words
3. If any of those target words are found, delete the words, or find/replace (find word, replace with a space)

I have pieces of a find/replace script, and I have pieces of a "edit title" script - but I'm struggling to integrate the two into a working solution.

Target words: Total, What, Where, Who, TTD
Example title, before/after: 'NEW WHERE' becomes 'NEW'

You could probably work around this:

Code:

---

Sub fix_Title()
Dim osld As Slide
Dim rayText() As String
Dim titleText As String
Dim L As Long
rayText = Split("Total,Who,What,Where,TTD", ",")
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
For L = 0 To 4
titleText = osld.Shapes.Title.TextFrame.TextRange.Text
If InStr(titleText, rayText(L)) > 0 Then
' Put replace code here
End If
Next L
End If
Next
End Sub

---

Thanks very much, John. Can you tell me what the L represents, in this scenario? Also, what's the correct syntax for the "replace" code, if I want to leave the title intact, minus the "target" word?


Oh, I think I understand - the L represents the number of target words, if you count 0 as 1. Is that right?

Yes

Arrays start by default at zero so it's 0,1,2,3,4

And would you mind addressing the "replace" code part? I'm struggling with the syntax that will "leave all intact, but delete the target word".

I think I would delete word rather than replace.

Something like this

Code:

---

Sub fix_Title()
Dim osld As Slide
Dim rayText() As String
Dim titleText As TextRange
Dim L As Long
rayText = Split("Total,Who,What,Where,TTD", ",")
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
For L = 0 To 4
Set titleText = osld.Shapes.Title.TextFrame.TextRange
If InStr(UCase(titleText), UCase(rayText(L))) > 0 Then
Set titleText = Deleter(titleText, rayText(L))
End If
Next L
End If
Next
End Sub


Function Deleter(otr As TextRange, strword As String) As TextRange
Dim L As Long
For L = otr.Words.Count To 1 Step -1
If Trim(UCase(otr.Words(L))) = UCase(strword) Then otr.Words(L).Delete
Next L
End Function

---

This is absolutely PERFECT. Thank you very much for the help you provide on a regular basis. It really is invaluable.
If you're so inclined, I'd love to see an explanation of the Function part of your solution. I want to grow to be self-sufficient(ish) in VBA :)