User is getting a worksheet with lots of columns.

They want a button atop each column that acts as a toggle - like the column
headers in Windows' directory windows do: Click on it the first time and the
whole sheet gets sorted by that col's values ascending. Click on it the second
time and the whole sheet gets sorted by that col's values descending.

If somebody could point me to an example it would save the client a few of my
man hours and maybe give me some "best practice" code instead of what I'd cobble
together from scratch.
--
PeteCresswell

Per (PeteCresswell):
If somebody could point me to an example

Oops!... Here it is:
http://www.contextures.com/xlSort02.html
--
PeteCresswell

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.

"(PeteCresswell)" wrote:

User is getting a worksheet with lots of columns.

They want a button atop each column that acts as a toggle - like the column
headers in Windows' directory windows do: Click on it the first time and the
whole sheet gets sorted by that col's values ascending. Click on it the second
time and the whole sheet gets sorted by that col's values descending.

If somebody could point me to an example it would save the client a few of my
man hours and maybe give me some "best practice" code instead of what I'd cobble
together from scratch.
--
PeteCresswell

--

Dave Peterson

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
-------------------------------------------------------------------------
--
PeteCresswell

Check out Chip Pearson's site:
http://cpearson.com/excel/vbe.htm

He shows how to write code that writes code.

But there can be difficulties. If the workbook's project is locked or if the
user didn't allow any program access to the project, then you'll have trouble.



"(PeteCresswell)" wrote:

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
-------------------------------------------------------------------------
--
PeteCresswell

--

Dave Peterson

Ps. Check Chip's site for importing a module, too. It might be easier--but the
same warnings apply.

"(PeteCresswell)" wrote:

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
-------------------------------------------------------------------------
--
PeteCresswell

--

Dave Peterson

Per Dave Peterson:
Check out Chip Pearson's site:
http://cpearson.com/excel/vbe.htm

He shows how to write code that writes code.

Thanks. I think I owe Chip a lunch or something.
--
PeteCresswell