I'm close, but it is only updating one shape per slide. Often times I will have multiple shapes with the same tag.

How can I cycle through all the shapes on each slide?


Sub addID()

    Dim oSld As Slide
    Dim oShp As Shape
    Dim i As Integer
    
    'Call deleteID
    
    'For Each oSld In ActivePresentation.Slides 'for all slides
    Set oSld = ActiveWindow.View.Slide 'for only the active slide
        Set oShp = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 100, 20)
        With oShp
            '.TextFrame.TextRange = CStr(osld.SlideID) 'adds slide ID number
            .TextFrame.TextRange = CStr(oSld.SlideID & "/" & oSld.SlideIndex) 'adds slide ID and Index number
            '.TextFrame.TextRange = CStr("Seq. " & osld.SlideIndex & "0") 'adds slide index number
            .Tags.Add "ID", CStr(oSld.SlideID)
        End With
    'Next oSld
    
End Sub

Sub deleteID()

    Dim oSld As Slide
    Dim slideSTR As String
    Dim i As Integer
    
    For Each oSld In ActivePresentation.Slides 'for all slides
        slideSTR = oSld.SlideID
        For i = oSld.Shapes.Count To 1 Step -1
            If oSld.Shapes(i).Tags("ID") = slideSTR Then oSld.Shapes(i).Delete
        Next i
    Next oSld
    
End Sub

Sub updateID()

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTemp As Shape
    Dim sTagValue As String

    On Error GoTo ErrorHandler
    
    For Each oSld In ActivePresentation.Slides 'for all slides
        sTagValue = oSld.SlideID
        For Each oShp In oSld.Shapes 'look at each shape on the slide
            'see if the tag has value we're after
            If oShp.Tags("ID") = sTagValue Then 'this is the shape we're after
                oShp.TextFrame.TextRange = CStr(oSld.SlideID & "/" & oSld.SlideIndex)
                Exit For
            End If
        Next
    Next oSld
    
NormalExit:
    Exit Sub
     
ErrorHandler:
    MsgBox "Error: " & Err.Number & " " & Err.Description
    Resume NormalExit

End Sub