Skip to content

Instantly share code, notes, and snippets.

@rposborne
Last active December 18, 2015 10:29
Show Gist options
  • Save rposborne/5768590 to your computer and use it in GitHub Desktop.
Save rposborne/5768590 to your computer and use it in GitHub Desktop.
@Scong "really crappy alphabatize"
Sub alphabatizeSelection(Optional control As IRibbonControl)
'almost works
Dim numberOfLines As Integer
Dim selectionArray() As Variant
'Dim iterator As Long: iterator = 0
Dim temprange As Range
Dim temptext As String: temptext = ""
temptext = Selection.Range.Text
numberOfLines = Len(temptext) - Len(Replace(temptext, Chr(13), ""))
'With Dialogs(wdDialogToolsWordCount)
' numberOfLines = .Lines
' .Execute
'End With
'MsgBox CStr(numberOfLines)
ReDim selectionArray(numberOfLines - 1)
Debug.Print numberOfLines
'builds array of selection
For iterator = 0 To numberOfLines - 1
Set temprange = Selection.Range
Selection.Collapse
temprange.Start = Selection.Start
Call Selection.EndOf(unit:=wdParagraph, Extend:=wdExtend)
temprange.End = Selection.End
selectionArray(iterator) = temprange.Text
temprange.Delete
Next
'sorts array
Call BubbleSort(selectionArray())
'reinserts array
For iterator = 0 To numberOfLines - 1
Selection.InsertAfter (selectionArray(iterator))
Next
End Sub
Sub BubbleSort(arr)
Dim strTemp As String
Dim i As Long
Dim j As Long
Dim lngMin As Long
Dim lngMax As Long
lngMin = LBound(arr)
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If Not IsNumeric(arr(i)) And Not IsNumeric(arr(j)) Then
If UCase(arr(i)) > UCase(arr(j)) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
ElseIf arr(i) > arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment