View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.worksheet.functions
GS[_6_] GS[_6_] is offline
external usenet poster
 
Posts: 1,182
Default Excel Formula (Not Macro) For Sorting By Row

Can you use a macro?

I'm open to all suggestions at this point...


I'm thinking your criteria "Not Macro" implies the file contains no macros;
-thus a macro in Personal.xls would be available to all open files.

What I suggest is to select the cells to be sorted before running the macro.
The SortData() macro will step through the selection row by row, sorting each
row as it goes.

Copy this code into a standard module:

Option Explicit

Sub SortData()
Dim vData, n&, j&, s1$, as1$()
vData = Selection
For n = LBound(vData) To UBound(vData)
s1 = "": Erase as1
For j = 1 To UBound(vData, 2)
s1 = s1 & "|" & Left(vData(n, j), 5)
Next 'j
as1 = Split(Mid(s1, 2), "|")
SelectionSort as1
For j = 1 To UBound(vData, 2)
vData(n, j) = as1(j - 1) '
Next 'j
Next 'n
Selection = vData
End Sub

Public Sub SelectionSort(ListArray() As String, _
Optional ByVal bAscending As Boolean = True, _
Optional ByVal bCaseSensitive As Boolean = False)

Dim sSmallest$, lSmallest&, lCount1&, lCount2&
Dim lMin&, lMax&, lCompareType&, lOrder&

lMin = LBound(ListArray): lMax = UBound(ListArray)
If lMin = lMax Then Exit Sub

'Order Ascending or Descending?
lOrder = IIf(bAscending, -1, 1)

'Case sensitive search or not?
lCompareType = IIf(bCaseSensitive, vbBinaryCompare, vbTextCompare)

'Loop through array swapping the smallest\largest (determined by lOrder)
'item with the current item
For lCount1 = lMin To lMax - 1
sSmallest = ListArray(lCount1): lSmallest = lCount1

'Find the smallest\largest item in the array
For lCount2 = lCount1 + 1 To lMax
If StrComp(ListArray(lCount2), sSmallest, lCompareType) = lOrder Then
sSmallest = ListArray(lCount2): lSmallest = lCount2
End If
Next

'Just swap them, even if we are swapping it with itself,
'as it is generally quicker to do this than test first
ListArray(lSmallest) = ListArray(lCount1)
ListArray(lCount1) = sSmallest
Next
End Sub

--
Garry

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