Attribute VB_Name = "Module_sortTable"
'   sortTable - FrontPage Table Sort Utility
'   Copyright (C) 2002  Stephen C. Travis
'
'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 2 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'   or visit their website at http://www.fsf.org/licenses/gpl.txt
'
Sub sortTable()
Dim sortYN
Dim nRows
Dim nCells
Dim rowIndex, cellIndex
Dim objectHierarchy(100)
Dim rowArray()
Dim tableArray(1000, 1000)
If Not FrontPage.ActiveDocument Is Nothing Then
    If FrontPage.ActivePageWindow.ViewMode = fpPageViewNormal Then
        n = 0
        Set objectHierarchy(n) = ActiveDocument.activeElement
        Tag = objectHierarchy(n).tagName
        Do Until Tag = "table" Or Tag = "body"
            If Tag = "tr" Then
                Set rowObject = objectHierarchy(n)
                rowIndex = rowObject.rowIndex
                cellIndex = ActiveDocument.activeElement.cellIndex
                sortYN = MsgBox("The table will be sorted on the " & ordinal(cellIndex + 1) & " column starting with the " & ordinal(rowIndex + 1) & " row." & vbCr & "Do you want to continue?", vbYesNo)
                If sortYN = 7 Then Exit Sub
            End If
            n = n + 1
            If n > 99 Then Exit Sub
            Set objectHierarchy(n) = objectHierarchy(n - 1).parentElement()
            Tag = objectHierarchy(n).tagName
        Loop
        If Tag = "body" Then
            MsgBox ("Place the cursor in a table cell.")
            Exit Sub
        End If
        Set rows = objectHierarchy(n).rows
        nRows = rows.Length - 1
        ReDim rowArray(nRows)
        For r = 0 To nRows
            If IsNumeric(rows(r).cells(cellIndex).innerText) Then
                rowArray(r) = CDec(rows(r).cells(cellIndex).innerText)
            ElseIf IsDate(rows(r).cells(cellIndex).innerText) Then
                rowArray(r) = CDate(rows(r).cells(cellIndex).innerText)
            Else
                rowArray(r) = rows(r).cells(cellIndex).innerText
            End If
            nCells = rows(r).cells.Length - 1
            For c = 0 To nCells
                tableArray(r, c) = rows(r).cells(c).innerHTML
            Next
        Next
        Call sortArray(rowIndex, rowArray, True)
        sortYN = MsgBox("Sort Ascending?", vbYesNo)
        For r = rowIndex To nRows
            If sortYN = 7 Then
                srcRow = nRows - r + rowIndex
            Else
                srcRow = r
            End If
            nCells = rows(r).cells.Length - 1
            For c = 0 To nCells
                rows(r).cells(c).innerHTML = tableArray(rowArray(srcRow), c)
            Next
        Next
    End If
End If
End Sub
Sub sortArray(startRow, ByRef arrArray, returnIndex)
    Dim row, j
    Dim StartingKeyValue, NewKeyValue, swap_pos
    Dim arr0Array()
    ReDim arr0Array(UBound(arrArray))
    For i = 0 To UBound(arrArray)
        arr0Array(i) = i
    Next
    For row = startRow To UBound(arrArray) - 1
        StartingKeyValue = arrArray(row)
        NewKeyValue = arrArray(row)
        swap_pos = row
        For j = row + 1 To UBound(arrArray)
            If arrArray(j) < NewKeyValue Then
                swap_pos = j
                NewKeyValue = arrArray(j)
            End If
        Next
        If swap_pos <> row Then
            arrArray(swap_pos) = StartingKeyValue
            arrArray(row) = NewKeyValue
            x = arr0Array(swap_pos)
            arr0Array(swap_pos) = arr0Array(row)
            arr0Array(row) = x
        End If
    Next
    If returnIndex Then
        For i = 0 To UBound(arrArray)
            arrArray(i) = arr0Array(i)
        Next
    End If
End Sub
Function ordinal(nInput)
    sInput = CStr(nInput)
    Select Case Right(sInput, 1)
        Case "1"
            ordinal = sInput & "st"
        Case "2"
            ordinal = sInput & "nd"
        Case "3"
            ordinal = sInput & "rd"
        Case Else
            ordinal = sInput & "th"
    End Select
    Select Case Right(sInput, 2)
        Case "11", "12", "13"
            ordinal = sInput & "th"
    End Select
End Function