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