I have the following code which what it does it searches the presentation for a specific word. In this case "Scott" and it returns each slide that has that word on it. I do not have much knowledge of VBA so any help would be appreciated. Basically my problem is I need to Redim Preserve the step array to reduce the amount of elements it has. Below is the code, function and output.


Sub Email()
Dim sld As Slide
Dim shp As Shape
Dim txtRng As TextRange
Dim foundText As TextRange
Dim slidecount As Integer
Dim step() As Variant
slidecount = ActivePresentation.Slides.Count
With ActivePresentation
a = "Scott: Component Status, Effective Dates Slides:"
Debug.Print a
ReDim step(slidecount)
For i = 1 To slidecount
   For Each shp In ActivePresentation.Slides(i).Shapes
       If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange
            Set foundText = txtRng.Find(FindWhat:="SCOTT")
            Do While Not (foundText Is Nothing)
                With foundText
                  
                    step(i) = ActivePresentation.Slides(i).SlideNumber
                    
                    Exit For
                End With
            Loop
        End If
    Next
Next
Call FilterDuplicates(step)
joinarray = Join(step, ",")
Debug.Print joinarray
End With
End Sub
And here is the function that is calls.

Function FilterDuplicates(step As Variant) As Long
    Dim col As Collection, index As Long, dups As Long
    Set col = New Collection
    On Error Resume Next
    Dim a() As String
    For index = LBound(step) To UBound(step)
        ' build the key using the array element
        ' an error occurs if the key already exists
        col.Add 0, CStr(step(index))
        If Err Then
            ' we've found a duplicate
            step(index) = Empty
            dups = dups + 1
            Err.Clear
        ElseIf dups Then
            ' if we've found one or more duplicates so far
            ' we need to move elements towards lower indices
            step(index - dups) = step(index)
            step(index) = Empty
        End If
    Next
    
    
    dups = FilterDuplicates(a())
     If dups Then
         ReDim Preserve a(LBound(a) To (UBound(a) - dups))
     End If
     
End Function

This is the output that I get hen i run this code.


Scott: ,4,5,8,14,17,20,23,35,37,39,45,47,50,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,


Basically I want to ReDim Preserve the array to the proper size but It doesnt seem to work in the function where I have written it.