View Single Post
  #26   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Modify Claus code "Sub Array_Var_Column_Sort()"

With Sheets("Sheet1")
Lcol = .Cells(1, Columns.Count).End(xlUp).Column


This is not needed.
Why End(xlUp) instead of...

lCol = .Cells(1, Columns.Count).End(xlToLeft).Column

LRow = .Cells(Rows.Count, 1).End(xlUp).Row


Also, name varKey is misleading since we're sorting columns within a
specified range. Here's what I came up with so far...


Const sColsToSort$ = "A,C,E"

Sub SheetSortRange(Optional Wks As Worksheet, Optional sCriteria$)
' Sorts all columns in specified range, keeping
' empty cells in place with 1st sort Key.
Dim vCols, n&, lRow, rngToSort As Range

If Wks Is Nothing Then Set Wks = ActiveSheet
If sCriteria = "" Then sCriteria = sColsToSort
vCols = Split(sCriteria, ",")

Application.ScreenUpdating = False: On Error GoTo Cleanup

With Wks
lRow = .UsedRange.Rows.Count: .Sort.SortFields.Clear
Set rngToSort = .Range(Cells(1, vCols(0)), _
Cells(lRow, vCols(UBound(vCols))))

For n = LBound(vCols) To UBound(vCols)
.Sort.SortFields.Add Key:=.Range(vCols(n) & "1"), _
Order:=xlDescending
Next

With .Sort
.SetRange rngToSort: .Header = xlNo: .MatchCase = False
.Apply
End With '.Sort
End With 'Wks

Cleanup:
Application.ScreenUpdating = True
Set Wks = Nothing: Set rngToSort = Nothing
End Sub 'SheetSortRange

Sub Test_SheetSortRange()
SheetSortRange Sheets("Sheet1"), sColsToSort
End Sub

...where this has no effect on data outside rngToSort!<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion