How do I automatically delete slides based on the content of their header?

ForEachSInSlides_Delete_Slides_TextinTitle.bas

Sub Delete_Slides_TextinTitle()

Dim Ppres As Presentation
Set Ppres = ActivePresentation

Dim PPS As Slide
Dim StrNo As Long
Dim Titel As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For Each PPS In Ppres.Slides

    'slide has a certain text in Slide Title
    Titel = PPS.Shapes.Title.TextFrame.TextRange
    StrNo = InStr(Titel, "Project")
    
    If StrNo <> 0 Then PPS.Delete

Next PPS

End Sub