TextBox Added to Each Slide Actually Added Many to Each Slide - vba

Question

I am very new at vba and need some guidance please. I am trying to add a text box to each slide (outside of the slide area), to view a slide's ID and Index at a quick glance. I have pieced together several bits to create the code below. it works, however the number of text boxes added to each slide is the number of slides in the presentation (112) instead of 1. I would also like to know how I can adapt this to be refreshed when changes to the slides are made.
Thanks in advance!
Here is the code:
Sub AddSlideInfo()
'Original Source: http://www.pptfaq.com/FAQ01180-Add-presentation-file-name-to-each-slide-master.htm
Dim x As Long
Dim oSh As Shape
Dim oSl As Slide
With ActivePresentation
On Error Resume Next 'In case the shape does not exist.
' On each slide in the presentation:
For x = 1 To .Slides.Count
Set oSl = ActivePresentation.Slides(x)
' Create a textbox at 0" from left,
' -120.24 points from top of slide ( -1.67") from top left corner
' Make it 90 points high, 300 points wide 1.25" x 5.5"
' Change any of these numbers at will
For Each oSl In ActivePresentation.Slides
With oSl
Set oSh = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=-120, Width:=300, Height:=90)
' Give it a name so we can find it later
oSh.Name = "SlideInfo"
'Add some formatting and dummy text
With oSh.TextFrame.TextRange
.Font.Name = "Berlin Sans Demi"
.Font.Size = 12
.Text = _
"Slide Info: " & vbNewLine & _
"Slide Index: " & oSl.SlideIndex & vbNewLine & _
"Slide ID: " & oSl.SlideID
End With
End With
Next
Next x
End With
End Sub

Answer 1

Your code loops though all the slides with the For x = 1 To .Slides.Count and then loops through all slides again with For Each oSl In ActivePresentation.Slides. You don't need both.
The following is a simplified version of your code. It only loops through the slides once. It deletes the SlideInfo textbox if it exists (using On Error Resume Next to catch the error) ... but you can clean that up later :) ... and then recreates the textbox cleanly each time.
Option Explicit
Sub AddSlideInfo()
Const cShapeName = "SlideInfo"
Dim oSh As Shape
Dim oSl As Slide
On Error Resume Next
With ActivePresentation
For Each oSl In ActivePresentation.Slides
With oSl
.Shapes(cShapeName).Delete
Set oSh = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=-120, Width:=300, Height:=90)
oSh.Name = cShapeName
'Add some formatting and dummy text
With oSh.TextFrame.TextRange
.Font.Name = "Berlin Sans Demi"
.Font.Size = 12
.Text = _
"Slide Info: " & vbNewLine & _
"Slide Index: " & oSl.SlideIndex & vbNewLine & _
"Slide ID: " & oSl.SlideID
End With
End With
Next
End With
End Sub