Sort Slides in VBA by NotesPage value

[ajruiz28]

This is my first post so please bear with me. I am trying to sort slides in a presentation based on the number value that I get from the NotesPage section of each slide. All slides have been preset with a number that I extract using a function in VBA. I have an array that contains these numbers and I then sort them using a bubble sort routine. Once the sort is finished I attempt to move the slides to the end. The problem is that it doesn't sort it properly. The numbers in the NotesPage section of the slides can range from 1 to 10,000. I want the sort routine to order the slides from lowest to highest, but can't seem to get it working! Please help. I have posted the current code below and if you want to test this out you must add a number value in the NotesPage section of the slides to be sorted in the format: {10}. My function parses the value between the brackets {}. All the code is behind slide 1 and is run from a button click. Any feedback is much appreciated!

Option Explicit
'

Private Sub cmdSort_Click()
'Sorts the slides based on the notesPage value ex: {1}
Dim x As Long
Dim raySlides() As Variant
Dim lIndex As Long
ReDim Preserve raySlides(1 To ActivePresentation.Slides.Count) As Variant
Dim sld As Slide
Dim notes As String

'Set array values
For x = 1 To ActivePresentation.Slides.Count
notes = ParseSlideNumber(ActivePresentation.Slides(x).NotesPage.Shapes.Placeholders (2).TextFrame.TextRange.Text)
raySlides(x) = notes & "|||" & CStr(x)
Next x

'Sort the array
Call BubbleSortVariantArray(raySlides())
lIndex = 1
For x = 1 To UBound(raySlides)
lIndex = CLng(Mid$(raySlides(x), InStr(raySlides(x), "|||") + 3))
ActivePresentation.Slides(lIndex).MoveTo ActivePresentation.Slides.Count
Next x

'Move master slide to 1st position
For Each sld In ActivePresentation.Slides
If ParseSlideNotes(sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Te xt) = "Master" Then
ActivePresentation.Slides(sld.SlideIndex).MoveTo 1
End If
Next sld

MsgBox "Finished Sorting Slides!", vbInformation, "Sort Slides"
End Sub

Private Function ParseSlideNumber(notes As String) As Integer
'Parses the notes string and retrieves the value between brackets
Dim leftBracket As Integer
Dim rightBracket As Integer

leftBracket = InStr(1, notes, "{")
rightBracket = InStr(1, notes, "}")

If leftBracket > 0 And rightBracket > 0 Then
ParseSlideNumber = CInt(Mid(notes, leftBracket + 1, rightBracket - 1 - leftBracket))
Exit Function
End If

ParseSlideNumber = 0
End Function

Public Sub BubbleSortVariantArray(rayIn() As Variant)

Dim lLow As Long
Dim lHigh As Long
Dim intX As Long
Dim intY As Long
Dim varTmp As Variant

On Error GoTo Errorhandler

' Get the bounds of the array
lLow = LBound(rayIn)
lHigh = UBound(rayIn)

For intX = lLow To lHigh - 1
For intY = intX + 1 To lHigh
If rayIn(intX) > rayIn(intY) Then
varTmp = rayIn(intX)
rayIn(intX) = rayIn(intY)
rayIn(intY) = varTmp
End If
Next intY
Next intX

NormalExit:
Exit Sub

Errorhandler:
MsgBox "There was a problem sorting the array"
Resume NormalExit
End Sub

[John Wilson]

Maybe this sort of thing would work?

Sub sortme()
Dim i As Integer
Dim L As Long
Dim coll As New Collection
For i = 1 To ActivePresentation.Slides.Count
L = getslide(i)
If L <> 0 Then
coll.Add (L)
End If
Next i
For i = 1 To coll.Count
ActivePresentation.Slides.FindBySlideID(coll(i)).MoveTo ActivePresentation.Slides.Count
Next i
End Sub

Function getslide(x As Integer) As Long
Dim osld As Slide
For Each osld In ActivePresentation.Slides
If InStr(osld.NotesPage.Shapes(2).TextFrame.TextRange, "{" & CStr(x) & "}") > 0 Then
getslide = osld.SlideID
Exit Function
End If
Next osld
End Function

[ajruiz28]

John,

Thank you for taking a crack at it. Unfortunately this code doesn't sort the slides from smallest to biggest. After modifying my code I'm in the same boat. I even tried reordering the collection, but that didn't work either. Here's the current code. Please note that I tried it exactly as you recommended and then I modified the bubblesort routine to reorder the collection, but still no luck :(


Private Sub cmdSort_Click()
'Sorts the slides based on the notesPage value ex: [1]

Dim i As Integer
Dim l As Long
Dim coll As New Collection

For i = 1 To ActivePresentation.Slides.Count
l = GetSlide(i)
If l <> 0 Then
coll.Add (l)
End If
Next i

Call BubbleSortVariantArray(coll)

For i = 1 To coll.Count
ActivePresentation.Slides.FindBySlideID(coll(i)).MoveTo ActivePresentation.Slides.Count
Next i

MsgBox "Finished Sorting Slides!", vbInformation, "Sort Slides"
End Sub

Function GetSlide(x As Integer) As Long
Dim osld As Slide
For Each osld In ActivePresentation.Slides
If InStr(osld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text, "{" & CStr(x) & "}") > 0 Then
GetSlide = osld.SlideID
Exit Function
End If
Next osld
End Function

Public Sub BubbleSortVariantArray(c As Collection)
Dim lLow As Long
Dim lHigh As Long
Dim intX As Long
Dim intY As Long
Dim varTmp As Variant

On Error GoTo Errorhandler

' Get the bounds of the array
lLow = 1 'LBound(c)
lHigh = c.Count 'UBound(c)

For intX = lLow To lHigh - 1
For intY = intX + 1 To lHigh
If c(intX) > c(intY) Then
varTmp = c(intX)
c(intX) = c(intY)
c(intY) = varTmp
End If
Next intY
Next intX

NormalExit:
Exit Sub

Errorhandler:
MsgBox "There was a problem sorting the array"
Resume NormalExit
End Sub

[John Wilson]

Maybe I'm misunderstanding.

Does this get closer

Sub sortme()
Dim osld As Slide
Dim strNum As String
Dim lngID As Long
'tag slides with number
For Each osld In ActivePresentation.Slides
strNum = ParseSlideNumber(osld)
If strNum <> "" Then osld.Tags.Add "NUM", strNum
Next osld
Do
'find slide with highest tag
Set osld = maxVal(ActivePresentation)
If Not osld Is Nothing Then
'move and remove tag
osld.MoveTo 1
osld.Tags.Delete ("NUM")
End If
'continue till all tags found
Loop While Not osld Is Nothing
End Sub

Function maxVal(opres As Presentation) As Slide
Dim osld As Slide
Dim tempNum As String
Set maxVal = Nothing
For Each osld In ActivePresentation.Slides
If Val(osld.Tags("NUM")) > Val(tempNum) Then
Set maxVal = osld
tempNum = osld.Tags("NUM")
End If
Next osld
End Function


Private Function ParseSlideNumber(thisslide As Slide) As String
Dim notes As String
Dim leftBracket As Integer
Dim rightBracket As Integer
notes = thisslide.NotesPage.Shapes(2).TextFrame.TextRange
'Parses the notes string and retrieves the value between brackets
leftBracket = InStr(1, notes, "{")
rightBracket = InStr(1, notes, "}")
If leftBracket > 0 And rightBracket > 0 Then
ParseSlideNumber = Mid(notes, leftBracket + 1, rightBracket - 1 - leftBracket)
Exit Function
End If
End Function

[ajruiz28]

John you are a genius! I made some minor changes to the code as shown below and it works like a champ! Thank you so much for the help! The code below works great for me so I thought I'd share in case anyone else can use it.


Option Explicit
'

Private Sub cmdSort_Click()
'Sorts the slides based on the notesPage value ex: [1]
Dim osld As Slide
Dim strNum As String
Dim lngID As Long

'tag slides with number
For Each osld In ActivePresentation.Slides
strNum = ParseSlideNumber(osld)
If strNum <> "" Then osld.Tags.Add "NUM", strNum
Next osld

Do
'find slide with highest tag
Set osld = maxVal(ActivePresentation)
If Not osld Is Nothing Then
'move and remove tag
osld.MoveTo 1
osld.Tags.Delete ("NUM")
End If
'continue till all tags found
Loop While Not osld Is Nothing

'Move master slide to 1st position
For Each osld In ActivePresentation.Slides
If ParseSlideNotes(osld) = "Master" Then
ActivePresentation.Slides(osld.SlideIndex).MoveTo 1
End If
Next osld
MsgBox "Finished Sorting Slides!", vbInformation, "Sort Slides"
End Sub

Function maxVal(opres As Presentation) As Slide
Dim osld As Slide
Dim tempNum As String
Set maxVal = Nothing
For Each osld In ActivePresentation.Slides
If Val(osld.Tags("NUM")) > Val(tempNum) Then
Set maxVal = osld
tempNum = osld.Tags("NUM")
End If
Next osld
End Function

Private Function ParseSlideNumber(thisslide As Slide) As String
Dim notes As String
Dim leftBracket As Integer
Dim rightBracket As Integer
notes = thisslide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange
'Parses the notes string and retrieves the value between brackets
leftBracket = InStr(1, notes, "{")
rightBracket = InStr(1, notes, "}")
If leftBracket > 0 And rightBracket > 0 Then
ParseSlideNumber = Mid(notes, leftBracket + 1, rightBracket - 1 - leftBracket)
Exit Function
End If
End Function

Private Function ParseSlideNotes(thisslide As Slide) As String
Dim notes As String
Dim leftBracket As Integer
Dim rightBracket As Integer
notes = thisslide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange
'Parses the notes string and retrieves the value between brackets
leftBracket = InStr(1, notes, "[")
rightBracket = InStr(1, notes, "]")
If leftBracket > 0 And rightBracket > 0 Then
ParseSlideNotes = Mid(notes, leftBracket + 1, rightBracket - 1 - leftBracket)
Exit Function
End If
End Function