Per Dave Peterson:
ps. If they're using xl2003, they could apply data|Filter|autofilter.
There's an option to sort by each column under the dropdown arrows.
Lazy users -) They're adamant about being able to just single-click on
the column header and have it happen.
Actually, I'm halfway home on this.
I've got the code to create the buttons from my VBA application running,
but I haven't figured out how to create a Sub in the Excel document
from afar. So right now, to make it work, I have to break the code, open
up the Excel document, and manually paste in the "SortSheet" macro.
To get home with this, I need to figure out how to create that macro
from VBA in another app that just has a pointer to the Excel.Application
that has the sheet open
-------------------------------------------------------------------------
Public Sub SortButtons_Create(ByVal theRowNum_Buttons As Long, _
ByVal theRowNum_DataFirst As Long, _
ByVal theRowNum_DataLast As Long, _
ByVal theColNum_ButtonFirst As Long, _
ByVal theColNum_ButtonLast As Long, _
ByVal theColNum_DataFirst As Long, _
ByVal theColNum_DataLast As Long, _
ByRef theWS As Excel.Worksheet)
13000 debugStackPush mModuleName & ": SortButtons_Create"
13001 On Error GoTo SortButtons_Create_err
' PURPOSE: - To put a series of invisible rectangles on a worksheet which,
' when clicked, will call a routine that sorts the entire sheet's
' data on that column's values.
' - To create/install a macro named "SortSheet" that will serve
' as the routine that sorts the sheet
' ACCEPTS: - Row number of the row to have the invisible
' rectangles installed on it
' - Row number of the first row tb sorted
' - Row number of the last row tb sorted
' - Col number of first column that gets a button
' - Col number of last column that gets a button
' - Col number of first column tb sorted (generally same
' as first col to get a button)
' - Col number of last column tb sortdd (generally same
' as last col to get a button)
13002 Dim myRange As Excel.Range
Dim myCell As Excel.Range
Dim myRect As Shape
13010 With theWS
13019 Set myRange = .Range(.Cells(theRowNum_Buttons, theColNum_ButtonFirst),_
..Cells(theRowNum_Buttons, theColNum_ButtonLast))
13020 For Each myCell In myRange.Cells
13030 With myCell
13031 Set myRect = .Parent.Shapes.AddShape _
(Type:=gExcelShape_Rectangle, _
Top:=.Top, _
Height:=.Height, _
Width:=.Width, _
Left:=.Left)
13039 End With
13040 With myRect
13041 .OnAction = "SortSheet"
13042 .Fill.Visible = False
13043 .Line.Visible = False
13049 End With
13990 Next myCell
13999 End With
SortButtons_Create_xit:
DebugStackPop
On Error Resume Next
Exit Sub
SortButtons_Create_err:
BugAlert True, ""
Resume SortButtons_Create_xit
End Sub
-------------------------------------------------------------------------
Here's the little Sub that I need to dynamically create in the .XLS.
The Consts would be doctored up on-the-fly to reflect the actual dimensions
of the sheet. I tried recording a macro, but it seemed like I was getting
into a chicken-and-egg situation.
-------------------------------------------------------------------------
Sub SortSheet()
Dim myWS As Worksheet
Dim myRange As Range
Dim myColToSort As Long
Dim mySortOrder As Long
Const rowNum_FirstData As Long = 4
Const rowNum_LastData As Long = 21
Const colNum_FirstData As Long = 1
Const colNum_LastData As Long = 8 '7
Set myWS = ActiveSheet
With myWS
myColToSort = .Shapes(Application.Caller).TopLeftCell.Column
Set myRange = .Range(.Cells(rowNum_FirstData, colNum_FirstData),
..Cells(rowNum_LastData, colNum_LastData))
myRange.Select
If .Cells(rowNum_FirstData, myColToSort).Value < .Cells(rowNum_LastData,
myColToSort).Value Then
mySortOrder = xlDescending
Else
mySortOrder = xlAscending
End If
myRange.Sort key1:=.Cells(rowNum_FirstData, myColToSort),
order1:=mySortOrder
End With
End Sub
