Macro to create Sort buttons
Mr X Z
Bouyed with the recent help I got from this wonderful forum I have a
request which is a daunting one so not for the faint hearted....
In a previous employment someone had created a macro that sorted
columns. The macro would present a userform which initially would
request the user to state the number columns that Buttons would be
required for and on completion would create and place these at the top
of each column. On pressing any one of the buttons all the data would
be sorted by reference to that column. It also sorted out the data in
the other direction if the same button was pressed. Finally the
userform also presented an option to remove the buttons.
This sounds like a professional job but that is beacuse of my lack of
knowledge - any takers???
Many thanks for reading
ML
Jim Cone
http://www.contextures.com/xlSort02.html
--
Jim Cone
Portland, Oregon USA .
http://www.mediafire.com/PrimitiveSoftware .
(List Files XL add-in: finds and lists files/folders with hyperlinks)
"Mr X Z" <mung...@gmail.com>
wrote in message
news:1a778f0a-6fa7-4869...@v8g2000yqb.googlegroups.com...
Mr X Z
I had been using Debra's brilliant site but for the life of me can't
explain why I hadn't look there!
It is exactly what I want except that I would prefer if the triangles
were replaced with command buttons that copied the cell entry as the
button name.
I have so far "lifted" this code below to use and despite many try's
can't work out how to incoporate it into Dave's code.
Be obliged if any one has any ideas.
Thank you for reading this.
ML
Sub CreateFormsButton()
Dim btn As Button
Dim rng As Range
With Worksheets("Sheet1")
Set rng = .Range("C1")
Set btn = .Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
With btn
.Caption = "Test"
.OnAction = "Test1"
End With
End With
End Sub
And Dave Petersons code
Sub SetupOneTime()
'adds rectangle at top of each column
'code written by Dave Peterson 2005-10-22
Dim myRng As Range
Dim myCell As Range
Dim curWks As Worksheet
Dim myRect As Shape
Dim iCol As Integer
Dim iFilter As Integer
iCol = 7 'number of columns
' 2010-Oct-31 added space for autofilter dropdowns
' set iFilter to 0 if not using autofilter
iFilter = 12 'width of drop down arrow
Set curWks = ActiveSheet
With curWks
Set myRng = .Range("a1").Resize(1, iCol)
For Each myCell In myRng.Cells
With myCell
Set myRect = .Parent.Shapes.AddShape _
(Type:=msoShapeRectangle, _
Top:=.Top, Height:=.Height, _
Width:=.Width - iFilter, Left:=.Left)
End With
With myRect
.OnAction = ThisWorkbook.Name & "!SortTable"
'' 2010-Oct-31 revised to fill shapes in Excel 2007
'' .Fill.Visible = False
.Fill.Solid
.Fill.Transparency = 1#
.Line.Visible = False
End With
Next myCell
End With
End Sub
Jim Cone
'adds rectangle at top of each column
'code written by Dave Peterson 2005-10-22
' so as to use buttons instead of rectangles.
Dim myRng As Range
Dim myCell As Range
Dim curWks As Worksheet
Dim myRect As Shape
Dim iCol As Integer
Dim iFilter As Integer
iCol = 7 'number of columns
iFilter = 14 'width of drop down arrow
Set curWks = ActiveSheet
With curWks
Set myRng = .Range("a1").Resize(1, iCol)
For Each myCell In myRng.Cells
With myCell
Set myRect = .Parent.Shapes.AddFormControl(xlButtonControl, _
Top:=.Top, Height:=.Height, _
Width:=.Width - iFilter, Left:=.Left)
End With
myRect.OnAction = ThisWorkbook.Name & "!SortTable"
myRect.TextFrame.Characters.Text = myCell.Value2
Next myCell
End With
End Sub
--
Jim Cone
Portland, Oregon USA
http://www.contextures.com/excel-sort-addin.html
editorial review of excel sorting add-in (30 ways to sort)
"Mr X Z" <mung...@gmail.com>
wrote in message
news:58d8d52e-9ba6-4cbd...@q30g2000yqb.googlegroups.com...
Mr X Z
Thanks once again.
I was hoping to use buttons and place the autofilter on top of them as
they would be preferable since they would size with the column as the
need arose.
Is this possible I wonder?
Thanks in advance
ML
Mr X Z
Bump...
Jim Cone
Is what possible and what happens when you try it?
"Mr X Z" <mung...@gmail.com>
wrote in message
news:5f16e0dc-c672-46fe...@fq4g2000vbb.googlegroups.com...
Mr X Z
Thank you for replying. Apologies for not making myself clear.
The buttons are great but they are fixed in size - I was hoping to
fill the cell that the heading was in plus if that column was resized
the button too would resize. Here is my pathetic attempt...
Sub SetupOneTime()
'adds rectangle at top of each column
'code written by Dave Peterson 2005-10-22
'screwed around with by Jim Cone 2011-06-12
' so as to use buttons instead of rectangles.
Dim myRng As Range
Dim myCell As Range
Dim curWks As Worksheet
'Dim myRect As Shape
Dim btn As Button
Dim iCol As Integer
Dim iFilter As Integer
iCol = 7 'number of columns
iFilter = 14 'width of drop down arrow
Set curWks = ActiveSheet
With curWks
Set myRng = .Range("a1").Resize(1, iCol)
For Each myCell In myRng.Cells
With myCell
Set btn = .Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Selection.AutoFilter
'Set myRect = .Parent.Shapes.AddFormControl(xlButtonControl, _
Jim Cone
overlapping the button.
The buttons won't automatically resize unless the button is exactly the same size as the cell.
So to get the buttons to resize, simply remove the " - iFilter" portion of the code to get:
"Width:=.Width"
Also, each button must have its "move and size with cells" property checkmarked (set to true).
On my system, that is the default - it doesn't have to be set.
I know of no way to change the size/position of the autofilter arrows.
'---
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(Lottery Numbers.xls: two national lotteries & twelve state lotteries - in the free folder)
"Mr X Z" <mung...@gmail.com>
wrote in message
news:ad9f2184-ed7e-479b...@j28g2000vbp.googlegroups.com...
> Hi Jim
> Thank you for replying. Apologies for not making myself clear.
> The buttons are great but they are fixed in size - I was hoping to
> fill the cell that the heading was in plus if that column was resized
> the button too would resize. Here is my pathetic attempt...
-snip-
Mr X Z
ML