Loop through slides and shapes to duplicate tables

Question

I want to:

1. Loop through all slides in the active presentation
2. Loop through the shapes in the slide
3. If it's a table and width is <410 then position it, make a duplicate and position duplicate. (I should also be checking to see if there is another table on the slide but I couldn't get that to work.)
4. If it's a table and width is >880 then simply position it.
5. Repeat until done.

The code goes into an infinite loop when duplicating and repositioning the new shape.

Sub test()

    Dim sld As Slide
    Dim shp As Shape
    Dim sr As Series
    Dim chrt As Chart

    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes

            If shp.HasTable Then
                
                With shp
                        
                    MsgBox .Width
                        
                    If .Width < 410 Then
                        
                        MsgBox "<410"
                        
                        .Top = 170
                        .Left = 35
                        .Width = 409

                        .Duplicate

                        .Top = 170
                        .Left = 515
                        .Width = 409
                        
                    End If
                        
                    If .Width > 880 Then
                        
                        MsgBox ">880"
                        
                        .Top = 170
                        .Left = 35
                        .Width = 889
                        
                    End If

                End With
                
            End If
                
        Next shp
    Next sld
End Sub

Answer 1

You want to avoid looping over sld.Shapes if you might be adding shapes to the slide within the loop.

One way to do that is to first collect the tables in a Collection and then loop over that:

Sub test()

    Dim sld As Slide
    Dim shp As Shape, shp2 As Shape
    Dim sr As Series
    Dim chrt As Chart, col As Collection

    For Each sld In ActivePresentation.Slides
        'first collect any existing table(s) on the slide
        Set col = New Collection
        For Each shp In sld.Shapes
            If shp.HasTable Then col.Add shp
        Next shp
        
        'check what was found
        If col.Count = 1 Then
            Set shp = col(1)
            If shp.Width < 410 Then
                shp.Top = 170
                shp.Left = 35
                shp.Width = 409
                Set shp2 = shp.Duplicate.Item(1) 'duplicate and get a reference to the new table
                shp2.Top = 170
                shp2.Left = 515
                shp2.Width = 409
            ElseIf shp.Width > 880 Then
                shp.Top = 170
                shp.Left = 35
                shp.Width = 889
            End If
        ElseIf col.Count > 1 Then
            '>1 table found - what to do here?
        End If
    Next sld
End Sub