Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Question for Dave Peterson | Excel Discussion (Misc queries) | |||
Dave Peterson - last question | Excel Discussion (Misc queries) | |||
Follow-up Question for Dave Peterson | Excel Discussion (Misc queries) | |||
Macro Question for Dave Peterson | Excel Discussion (Misc queries) | |||
Print question - Calling Dave Peterson! | Excel Discussion (Misc queries) |