Sub AddDetailedProgressBar()
 
    ScreenUpdating(FindWindowHandle(Application)) = False
    RemoveDetailedProgressBar
 
 
    On Error Resume Next
    Dim presentation As PowerPoint.presentation
    Dim s As PowerPoint.Shape
    Set presentation = Application.ActivePresentation
    Dim counter As Integer: counter = 0
    Dim slide As slide
 
 
    Dim X As Integer: X = 0
    Dim initialTop As Integer: initialTop = 0
    Dim initialLeft As Integer: initialLeft = 0
    Dim bulletCounter As Integer: bulletCounter = 0
    Dim Count As Integer: Count = 0
 
 
    Dim sectionCounter As Integer: sectionCounter = 0
    Dim slidesPerSection As Integer: slidesPerSection = 0
    Dim numberOfSections As Integer: numberOfSections = 0
    Dim sectionLength As Variant: sectionLength = 0
 
    Dim mySections() As Integer
    Dim sectionSlides() As Integer
    ReDim Preserve mySections(0 To 1)
    ReDim Preserve sectionSlides(0 To 1)
 
 
    ' Determine structure of slide set
    With presentation
        For X = 1 To .Slides.Count
            Dim notHidden As Boolean
            notHidden = Not .Slides(X).SlideShowTransition.Hidden
 
            Dim notIgnored As Boolean
 
 
            If .Slides(X).NotesPage.Tags.Count = 0 Then
                notIgnored = True
            Else
                notIgnored = False
            End If
 
 
 
            If notHidden And notIgnored Then
                'get slide numbers
                ReDim Preserve sectionSlides(0 To (UBound(sectionSlides) + 1))
 
                sectionSlides(counter) = .Slides(X).slideNumber
 
 
                counter = counter + 1
                If IsNull(.Slides(X).Shapes("section")) Then
                    mySections(sectionCounter) = mySections(sectionCounter) + 1
                Else
                    ReDim Preserve mySections(0 To (UBound(mySections) + 1))
                    sectionCounter = sectionCounter + 1
                    mySections(sectionCounter) = 1
                End If
 
            End If
        Next X
    End With