Question for Dave Peterson - Column Sorter

[Greg Glynn]

Hi Dave,

In your excellent Table Sort procedure, using hidden rectangles, we
use the Sub SetUpOneTime() macro to place the rectangles on the header
line.

What is the best way to add another column to a table that already has
been through the SetUpOneTime process? I was thinking that removing
the boxes somehow, then adding the column, then running SetUpOneTime()
again was one way. Perhaps I've overcomplicating it.

Greg

Option Explicit
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
iCol = 10 '10 columns

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, Left:=.Left)
End With
With myRect
.OnAction = ThisWorkbook.Name & "!SortTable"
.Fill.Visible = False
.Line.Visible = False
End With
Next myCell
End With
End Sub

Sub SortTable()

'code written by Dave Peterson 2005-10-22
'2006-08-06 updated to accommodate hidden or filtered rows
Dim myTable As Range
Dim myColToSort As Long
Dim curWks As Worksheet
Dim mySortOrder As Long
Dim FirstRow As Long
Dim TopRow As Long
Dim LastRow As Long
Dim iCol As Integer
Dim strCol As String
Dim rng As Range
Dim rngF As Range

TopRow = 1
iCol = 10 '10 columns
strCol = "A" ' column to check for last row

Set curWks = ActiveSheet

With curWks
LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
If Not .AutoFilterMode Then
Set rng = .Range(.Cells(TopRow, strCol), .Cells(LastRow,
strCol))
Else
Set rng = .AutoFilter.Range
End If

Set rngF = Nothing
On Error Resume Next
With rng
'visible cells first column of range
Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
End With
On Error GoTo 0

If rngF Is Nothing Then
MsgBox "No visible rows. Please try again."
Exit Sub
Else
FirstRow = rngF(1).Row
End If

myColToSort = .Shapes(Application.Caller).TopLeftCell.Column

Set myTable = .Range("A" & TopRow & ":A" & LastRow).Resize(, iCol)
If .Cells(FirstRow, myColToSort).Value _
< .Cells(LastRow, myColToSort).Value Then
mySortOrder = xlDescending
Else
mySortOrder = xlAscending
End If
myTable.Sort key1:=.Cells(FirstRow, myColToSort), _
order1:=mySortOrder, _
header:=xlYes
End With

End Sub

 

[Greg Glynn]

Also Dave ... I think I've made a mistake at some stage on one
implementation of this, because on trying to exit and save the
worksheet Excel reports "Shape is too large and will be truncated".
Is there a way to DISPLAY all the visible rectangles (for debugging
purposes)? I ask this because I can't tell which sheet the error is
on.

Greg

 

[Dave Peterson]

That's what I'd do.

Maybe even add a line like this:

With curWks
.rectangles.delete
'rest of code

But only if all the rectangles can be deleted.

 

[Dave Peterson]

I don't think I've ever seen that error when I was testing this. But I believe
you <vbg>.

If you want to show the rectangles while you're testing, you can use:

.Line.Visible = True
(instead of using = false)

If you ever want to see the rectangles (or hide them), you can activate that
sheet, open the VBE and hit ctrl-g to see the immediate window.

Then type this and hit enter:
activesheet.rectangles.visible = true

Change that to false when you want to hide them again.

 

[Greg Glynn]

Perfect. Thanks Dave. Great Code by the way.

 

[Dave Peterson]

Thanks.

If you're using xl2003, you can apply data|filter and there's a Sort option
available that kind of negates the use for this kind of code.

 

[Greg Glynn]

Well that's true, I could use Filters, but even this type of simple
data manipulation seems to be too hard for many of my users (I work in
Government)

;-)

 

[Dave Peterson]

Every once in a while, it's nice to make it easy for others--even if they're not
part of the government <vbg>.

But you may want to remember it if you're doing something for yourself. It may
make your life in excel a little faster.