View Single Post
  #45   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Worksheet sorting code/technique advise

I'm not getting any errors! For clarity...

In ThisWorkbook:
Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim vSortCriteria
On Error Resume Next '//if name doesn't exist
vSortCriteria = Sh.Range("SortCriteria").Value
If Not vSortCriteria = Empty Then Call SortCols(Sh, vSortCriteria)
End Sub

In a standard module:
Option Explicit

Sub SortCols(Wks As Worksheet, SortCriteria)
' Sorts individual specified cols
' Args: Wks The worksheet to be sorted
' SortCriteria Delimited string of col labels
' Not case sensitive
' **Note that SortCriteria is multi-delimited
' where sort order is delimited by a colon,
' and col labels by a comma. Left side of colon
' gets sorted ascending; right side descending.
' Examples: sort ascending only: "a,b,c,d,e:"
' sort descending only: ":a,b,c,d,e"
' sort both: "a,b,c:d,e"

Dim vSortCriteria, vCols, vSortOrder, v, bOrderBoth As Boolean

'Assume both sort orders
bOrderBoth = True

'Determine sort order
vSortCriteria = Split(SortCriteria, ":")
If vSortCriteria(0) = Empty Then _
bOrderBoth = False: vSortOrder = xlDescending: GoTo SortU
If vSortCriteria(1) = Empty Then _
bOrderBoth = False: vSortOrder = xlAscending: GoTo SortL

SortL:
If bOrderBoth Then vSortOrder = xlAscending
For Each v In Split(vSortCriteria(0), ",")
Wks.Columns(v).Sort Key1:=Wks.Cells(1, v), _
Order1:=vSortOrder, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Next 'v
If Not bOrderBoth Then Exit Sub

SortU:
If bOrderBoth Then vSortOrder = xlDescending
For Each v In Split(vSortCriteria(1), ",")
Wks.Columns(v).Sort Key1:=Wks.Cells(1, v), _
Order1:=vSortOrder, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Next 'v
End Sub

--
Garry

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