Sorting Text

Sub SortSelection ()
'DESCRIPTION: Sorts Selection
    Dim win
    set win = ActiveWindow  
    If win.type <> "Text" Then
        MsgBox "This macro can only be run when a text editor window is active."
        Exit Sub
    End If

    StartLine = ActiveDocument.Selection.TopLine
    EndLine = ActiveDocument.Selection.BottomLine       
    If EndLine < StartLine Then
        Temp = StartLine            
        StartLine = EndLine         
        EndLine = Temp      
    End If

    EndLine = EndLine - 1         

    If StartLine > EndLine Then
        Exit Sub
    End If

    bStop = false

    Do While Not bStop
        bStop = true
        For i = StartLine  To EndLine            
            ActiveDocument.Selection.GoToLine i         
            ActiveDocument.Selection.SelectLine
            FirstLine = ActiveDocument.Selection         

            ActiveDocument.Selection.GoToLine i + 1        
            ActiveDocument.Selection.SelectLine
            SecondLine = ActiveDocument.Selection         

            If FirstLine > SecondLine Then 
                bStop = false
                ActiveDocument.Selection.GoToLine i
	            ActiveDocument.Selection.StartOfLine
	            ActiveDocument.Selection.MoveTo i + 1, dsEndOfLine, dsExtend
                ActiveDocument.Selection = SecondLine +  FirstLine    
	            ActiveDocument.Selection.EndOfLine
	            ActiveDocument.Selection.Delete
            End If
        Next
    Loop
    ActiveDocument.Selection.GoToLine StartLine
    ActiveDocument.Selection.StartOfLine
    ActiveDocument.Selection.MoveTo EndLine + 1, dsEndOfLine, dsExtend
End Sub

Date Last Updated: February 12, 1999