Search code examples
vbapowerpoint

Find all slides with a specific Tags.Value and delete them


New to VBA. I have a large PPT with over 150 slides, and I have run a VBA macro to tag them (SlidesA ... SlidesF) into tag "groupings". I have a userform with a bunch of check boxes to select slide groupings the user wants keep. After selecting the groupings the user wants to keep they click an OK button. I have some code (below) to find slides that are not checked and delete them based on Tags.Value, and keep the rest. But for some reason it's not deleting all the slides, it's just deleting like 4 of them in SlidesA group.

Private Sub btnOK_Click()

' Slide.Tag has .Name and .Value parameters

If chkSlidesA = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesA" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesB = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesB" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesC = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesC" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesD = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesD" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesE = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesE" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

If chkSlidesF = False Then
    For Each s In Application.ActivePresentation.Slides
    With s.Tags
        For i = 1 To .Count
            If .Value(i) = "SlidesF" Then
            s.Delete
            End If
        Next i
    End With
    Next
Else

End If
End If
End If
End If
End If
End If

Unload Me

End Sub

I have verified the slides are tagged with the right values by running some VBA to read the tags and display a MsgBox to display the tag value.

I'm trying to understand why it isn't deleting all the slides.


Solution

  • So other people can see the revised solution that worked for me, here is my final working version of the code:

    Private Sub btnOK_Click()
        Dim concatSlidesAF As String
        concatSlidesAF = IIf(chkSlidesA, "", "A") & IIf(chkSlidesB, "", "B" & _
                         IIf(chkSlidesC, "", "C") & IIf(chkSlidesD, "", "D") & _
                         IIf(chkSlidesE, "", "E") & IIf(chkSlidesF, "", "F")
        
        If Len(concatSlidesAF) = 0 Then
            GoTo ES
        Else
            concatSlidesAF = "Slides[" & concatSlidesAF & "]"
        End If
        
        Dim i As Long, j As Long
        With Application.ActivePresentation.Slides
            For i = .Count To 1 Step -1
                With .Item(i)
                    For j = 1 To .Tags.Count
                        If .Tags.Value(j) Like concatSlidesAF Then
                            .Delete
                            Exit For
                        End If
                    Next j
                End With
            Next i
        End With
    
    Call DeleteEmptySections
    
    ES:
        Unload Me
    End Sub
    

    I also included a Sub to find and delete any sections that no longer contained any slides:

    Sub DeleteEmptySections()
        Dim lSP As Long
        With ActivePresentation.SectionProperties
            For lSP = .Count To 1 Step -1
                If .SlidesCount(lSP) = 0 Then .Delete lSP, True
            Next
        End With
    End Sub