I copied a bunch of your slides to have more to test with so the textbox comments are out of date
Slide 1, 2, Las, and next to last - marked with circle-X so no PB
Slides 5, 10, 15,20, and 25 are hidden - marked with circle-X so no PB
To test the 'manual input' I used slides 4, 9, 14, and 19 - marked with circle-X so no PB
Option Explicit
Sub ProgressBar()
Dim oPres As Presentation
Dim oSlide As Slide
Dim i As Long, j As Long
Dim sInput As String
Dim arySkip() As Long, aryAdd() As Long, n1 As Long, n2 As Long
Set oPres = ActivePresentation
'skip first 2 and last 2
ReDim arySkip(1 To 4)
arySkip(1) = 1
arySkip(2) = 2
arySkip(3) = oPres.Slides.Count - 1
arySkip(4) = oPres.Slides.Count
'get manual slide to ignore and put into arySkip
n1 = UBound(arySkip)
n2 = 0
Do While True
sInput = InputBox("Enter a slide to ignore, blank when done", "Ignore Slides")
If Len(sInput) > 0 Then
n1 = n1 + 1
ReDim Preserve arySkip(1 To n1)
arySkip(n1) = CLng(sInput)
Else
Exit Do
End If
Loop
'build array of slides to add PB to in aryAdd
For Each oSlide In ActivePresentation.Slides
If UBound(arySkip) > 0 Then
For i = LBound(arySkip) To UBound(arySkip)
If arySkip(i) = oSlide.SlideNumber Then GoTo NextSlide
Next i
End If
If oSlide.SlideShowTransition.Hidden Then GoTo NextSlide
n2 = n2 + 1
ReDim Preserve aryAdd(1 To n2)
aryAdd(n2) = oSlide.SlideNumber
NextSlide:
Next oSlide
'delete any existing PB except on slide 1 to copy
For Each oSlide In ActivePresentation.Slides
If oSlide.SlideNumber <> 1 Then
For i = oSlide.Shapes.Count To 1 Step -1
If oSlide.Shapes(i).Name = ("_ProgressBar") Then oSlide.Shapes(i).Delete
Next i
End If
Next oSlide
'no slide gets PB
If n2 = 0 Then Exit Sub
'copy PB on slide 1
With oPres
For i = LBound(aryAdd) To UBound(aryAdd)
.Slides(1).Shapes("_ProgressBar").Duplicate
.Slides(aryAdd(i)).Shapes.Paste
.Slides(aryAdd(i)).Shapes("_ProgressBar").Visible = msoTrue
'Bar Re-Size based on quantity of slides.
.Slides(aryAdd(i)).Shapes("_ProgressBar").Width = i * oPres.PageSetup.SlideWidth / UBound(aryAdd)
Next i
End With
End Sub