Alphabetize text extracted from text boxes

[leaning]

Hello!

Back on VBAExpress post 54245 (won't let me link to it), I got some great help with this macro (Goes through PPT slides, and if text is red and bold, it creates an index page with that text and slide number.

It works fine, but it puts the capital text A-Z and then lowercase a-z. Can anyone help so it is truly alphabetical Aa-Zz?

Sub StartHere()
 Dim osld As Slide
 Dim oshp As Shape
 Dim rayTitles() As String
 Dim i As Integer
 ReDim rayTitles(1 To 1)
 For Each osld In ActivePresentation.Slides
 For Each oshp In osld.Shapes
 If oshp.HasTextFrame Then
 If oshp.TextFrame.HasText Then
 For i = 1 To oshp.TextFrame.TextRange.Runs.Count
 With oshp.TextFrame.TextRange.Runs(i).Font
 If .Color.RGB = vbRed And .Bold = True Then
 rayTitles(UBound(rayTitles)) = oshp.TextFrame.TextRange.Runs(i) & "\" & osld.SlideNumber + 1
 ReDim Preserve rayTitles(1 To UBound(rayTitles) + 1)
 End If
 End With
 Next i
 End If
 End If
 Next oshp
 Next osld
 ReDim Preserve rayTitles(1 To UBound(rayTitles) - 1)
 Call mySort(rayTitles)
 Call make_sum(rayTitles)
 End Sub

 Function mySort(ArrayIn As Variant) As Variant
 Dim b_Cont As Boolean
 Dim lngCount As Long
 Dim strSwap As String
 Do
 b_Cont = False
 For lngCount = LBound(ArrayIn) To UBound(ArrayIn) - 1
 If ArrayIn(lngCount) > ArrayIn(lngCount + 1) Then
 strSwap = ArrayIn(lngCount)
 ArrayIn(lngCount) = ArrayIn(lngCount + 1)
 ArrayIn(lngCount + 1) = strSwap
 b_Cont = True
 End If
 Next lngCount
 Loop Until Not b_Cont
 End Function

 Sub make_sum(rayInstring As Variant)
 Dim osld As Slide
 Dim i As Integer
 For Each osld In ActivePresentation.Slides
 If osld.Tags("SUM") = "YES" Then
 osld.Delete
 Exit For
 End If
 Next osld
 Set osld = ActivePresentation.Slides.Add(1, ppLayoutText)
 osld.Tags.Add "SUM", "YES"
 osld.Shapes(2).TextFrame2.AutoSize = msoAutoSizeTextToFitShape
 osld.Shapes(2).TextFrame.Ruler.TabStops.Add ppTabStopLeft, 450
 With osld
 For i = 1 To UBound(rayInstring)
 .Shapes(2).TextFrame.TextRange = .Shapes(2).TextFrame.TextRange & Split(rayInstring(i), "\")(0) & ": " & Split(rayInstring(i), "\")(1) & vbCrLf
 Next i
 End With
 End Sub

Regards,
leaning

[Paul_Hossler]

Just lookin at it, try changing

Option 1

If ArrayIn(lngCount) > ArrayIn(lngCount + 1) Then

to

If LCase(ArrayIn(lngCount)) > LCase(ArrayIn(lngCount + 1)) Then

Option 2

https://docs.microsoft.com/en-us/dot...pare-statement

In the standard module, where you usually have Option Explicit, add another line Option Compare Text