GeniusIdeas,
You have to evaluate the assumptions in the program (i.e. read the comments
and evaluate the code). Basically, Integers are assumed for the sort, and
the Integers start at 1 and each consecutive value is 1 plus the previous
value. If you are not familiar with the MATCH function, look it up with the
Excel help.
Best,
Matthew Herbert
Sub CustomSortRoutine()
Dim Rng As Range
Dim rngCell As Range
Dim rngTemp As Range
Dim intArrHdr() As Integer
Dim varArr As Variant
Dim varItem As Variant
Dim intCnt As Integer
Dim lngCnt As Long
Dim varMatch As Variant
Application.ScreenUpdating = False
'assumes you are using Integers only
Set Rng = Selection
'create a lookup array and fill it will consecutive
' numbers, starting at 1; assumes Option Base 0
' which is the default setting
ReDim intArrHdr(Rng.Columns.Count - 1)
For intCnt = LBound(intArrHdr) To UBound(intArrHdr)
intArrHdr(intCnt) = intCnt + 1
Next intCnt
'loop through each row of Rng
For lngCnt = 1 To Rng.Rows.Count
'create a temporary range that references the
' entire row
Set rngTemp = Rng.Rows(lngCnt)
'load the current row's values into an array
varArr = rngTemp.Value
'clear the temporary range
rngTemp.Clear
'loop through each item in the array
For Each varItem In varArr
'match the varItem with intArrHdr. If a match exists,
' offset the value to the appropriate position in the
' row. (If no match, do nothing).
varMatch = Application.Match(varItem, intArrHdr, 0)
If Not IsError(varMatch) Then
'offset from the far-left cell of the row, placing
' the matching value into the offset cell
rngTemp.Cells(1, 1).Offset(0, varMatch - 1).Value = varItem
End If
Next varItem
Next lngCnt
End Sub
