Adding slide numbers to an array based off criteria

Question

I'm at hair pulling out stage and have conceded that I need someone with far greater knowledge and understanding than me to push this over the line!

This is a bit of a two part question - the first is specifically about this code but the second question is really, am I even going about this in the right way ? Either way, I'd still love to figure out what's wrong with my code so I can get better.

Desired code objective: To search through every slide in a presentation looking for a shape with the name 'Update' and another shape named 'Monthly' or 'Weekly' (for example) on the same slide. Once it finds these shapes, I'll run a seperate bit of code to manipulate that specific slide (this code is already finished and works perfectly).

My intended solution: First loop through every slide looking for the shape named 'Update'. This shape will always be on the slide when needed but the 'monthly'/'weekly' shape is a name which changes according to the update frequency required. Once the 'Update' shape is found, add that slide number to an array. Once finished doing the whole presentation, then check those slides in the array again and see if a shape exists named either 'Monthly', 'Weekly' etc. and call code accordingly.

My problem: The code does find the shape named 'Update' successfully but I cannot work out how to get the slide numbers into the array.

This code works but it makes every element of the array equal to the final slide number. So for example, if a presentation has 3 slides with 'update' and the last slide number is 7, the array would end up returning array(0) = 7, array(1) = 7, array(2) = 7. As I've stepped through, it is redimensioning the array size correctly and using the right slide number until it finds the next slide with 'update' and then it overwrites itself and uses the new slide number for every part of the array.

Sub New_test()
' Code objectives:
' Figure out which slide has the shape named "Update"
' Add that slide to an array with the corresponding slide number in
' Loop through each slide in that array, see if slide contains the shape named "Monthly"
' If so, run another macro

Dim myArr() As Variant
Dim oShape As Shape
Dim i As Long, j As Long

ReDim myArr(0)

For i = 1 To ActivePresentation.Slides.Count
    For Each oShape In ActivePresentation.Slides(i).Shapes
        If oShape.Name = "Update" Then
            ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
            j = j + 1
            For j = LBound(myArr) To UBound(myArr)                      'Begin looping through the array
                myArr(j) = ActivePresentation.Slides(i).SlideNumber     'Assign SlideNumber value to array
            Next j
        End If
    Next oShape
Next i

For i = 0 To UBound(myArr)
    Debug.Print "Array:"; myArr(i)
Next i
 
End Sub

Final question - am I going about this the right way? This code has come after a long time trying to think of a way of doing this and it seems to me to be the most sensible way, however, I'm entirely self-taught and only been using VBA often for a year so aware I may not be thinking like a programmer yet.

I initially tried to do a really simple 'For each' loop but couldn't figure out how to make the code loop back through a slide once it found the shape named 'Update' and then act accordingly as to whether the second shape was on the slide named 'Monthly', 'Weekly' etc. Any advice on an alternative approach I hadn't thought of would also be greatly appreciated.

Answer 1

To answer the immediate problem, change this:

For i = 1 To ActivePresentation.Slides.Count
    For Each oShape In ActivePresentation.Slides(i).Shapes
        If oShape.Name = "Update" Then
            ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
            j = j + 1
            For j = LBound(myArr) To UBound(myArr)                      'Begin looping through the array
                myArr(j) = ActivePresentation.Slides(i).SlideNumber     'Assign SlideNumber value to array
            Next j
        End If
    Next oShape
Next i

to this:

    For i = 1 To ActivePresentation.Slides.Count
        For Each oShape In ActivePresentation.Slides(i).Shapes
            If oShape.Name = "Update" Then
                If ExistSpecialShape(ActivePresentation.Slides(i) then
                    ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
                End if
' Your original loop was assigning the value of J to every element in the array
' every time you invoked the loop; that's why you filled it with the last slide number
' And use SlideIndex rather than SlideNumber.
' SlideNumber is the number that appears on printouts and such.
' Normally it's the same as SlideIndex, but if the user has chosen to start
' slide numbering at something other than 1, your results will be cockeyed.
' SlideIndex won't change in that situation.
                myArr(Ubound(myArr)) = ActivePresentation.Slides(i).SlideIndex    'Assign SlideNumber value to array
            End If
        Next oShape
    Next i

After the End Sub to this subroutine, add

ExistSpecialShape(oSl as Slide) as Boolean Dim oSh as Shape For each oSh in oSl.Shapes Select Case oSh.Name Case Is = "Monday" ExistSpecialShape = True Exit Function Case Is = "Wednesday" ExistSpecialShape = True Exit Function ' and so on, one case for each shape name you want to test End Select Next End Function

Another thing to consider is that users can easily change the name of shapes using the selection pane, and PPT can be sloppy about adding multiple shapes with the same name if users dupe a shape.

You might want to read up on Tags. More reliable than shape names, more flexible and not accessible to users.

There's a bit of basic info about Tags in the PPT FAQ I maintain here: Working with Tags (and a bit about Functions) https://www.pptfaq.com/FAQ00815_Working_with_Tags_-and_a_bit_about_Functions-.htm