Sub ABC()
' Variable definitions
Dim oSld As Slide
Dim oShp As Shape
Dim lTotalSlides As Long
Dim Slidenumber, SlidesNeeded, Team As String
Dim strResponse As String
' Defining the date used in nomenclature of file
myDate = Format(Date, "_yyyy_mm_dd")
'Define team name
Team = "ABC"
' Saving paths
ActivePresentation.ExportAsFixedFormat "O:\ABC" & myDate & ".pdf", ppFixedFormatTypePDF
' Finding the numbers of the required slides
Slidenumber = "" ' define an empty variable for later use
SlidesNeeded = "14,15,16,17,18,29,30,40,55,56,70,85,113,127,1 28" 'define the basic slides (dividers, etc. that are need in any presentation) -> may need adjustment from time to time
lTotalSlides = ActivePresentation.Slides.Count
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find(Team) Is Nothing Then
Else: Slidenumber = oSld.Slidenumber
SlidesNeeded = SlidesNeeded & "," & Slidenumber ' expands the SlidesNeeded with the slides that contain the team name in the title
End If
End If
Next
Next
' Deleting all unnecessary slides
Dim x As Long
Dim lSlideNumber As Long
Dim rayKeep() As String
Dim bKeeper As Boolean
Dim oPres As Presentation
rayKeep() = Split(SlidesNeeded, ",")
Set oPres = ActivePresentation
With oPres
For lSlideNumber = .Slides.Count To 1 Step -1
For x = LBound(rayKeep) To UBound(rayKeep)
If .Slides(lSlideNumber).SlideIndex = CLng(rayKeep(x)) Then
'.Slides(lSlideNumber).Delete
bKeeper = True
End If
Next
If Not bKeeper Then
.Slides(lSlideNumber).Delete
End If
bKeeper = False
Next
End With
End Sub
Sub CEE()
Dim oSld As Slide
Dim oShp As Shape
Dim lTotalSlides As Long
Dim Slidenumber, SlidesNeeded, Team As String
Dim strResponse As String
myDate = Format(Date, "_yyyy_mm_dd")
Team = "CEE"
ActivePresentation.ExportAsFixedFormat "O:\CEE" & myDate & ".pdf", ppFixedFormatTypePDF
Slidenumber = "" ' define an empty variable for later use
SlidesNeeded = "14,15,16,17,18,29,30,40,55,56,70,85,113,127,1 28" 'define the basic slides (dividers, etc. that are need in any presentation) -> may need adjustment from time to time
lTotalSlides = ActivePresentation.Slides.Count
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find(Team) Is Nothing Then
Else: Slidenumber = oSld.Slidenumber
SlidesNeeded = SlidesNeeded & "," & Slidenumber ' expands the SlidesNeeded with the slides that contain the team name in the title
End If
End If
Next
Next
' Deleting all unnecessary slides
Dim x As Long
Dim lSlideNumber As Long
Dim rayKeep() As String
Dim bKeeper As Boolean
Dim oPres As Presentation
rayKeep() = Split(SlidesNeeded, ",")
Set oPres = ActivePresentation
With oPres
For lSlideNumber = .Slides.Count To 1 Step -1
For x = LBound(rayKeep) To UBound(rayKeep)
If .Slides(lSlideNumber).SlideIndex = CLng(rayKeep(x)) Then
'.Slides(lSlideNumber).Delete
bKeeper = True
End If
Next
If Not bKeeper Then
.Slides(lSlideNumber).Delete
End If
bKeeper = False
Next
End With
End Sub