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.