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

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.

CodePudding user response：

@freeflow's my comment translated into 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
ES:
    Unload Me
End Sub

I used concatSlidesAF just so I can condense the code a bit.

CodePudding user response：

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