wacky sort order question

  • Thread starter Thread starter TheObstacleIsThePath
  • Start date Start date
T

TheObstacleIsThePath

I have a number sequence stored in an array, and would like to sort
the rows of a worksheet by this sequence, how would i go about doing
it? A cumbersome way is to paste that array into a temporary column,
and then sort by that column, but I prefer to do everything within the
VBScript subroutine.

If someone could just point me in the right direction, i'd appreciate
it.

Thanks,
Todd

(and yes, this is sort of a repost of an earlier question. I thought
some gracious soul might be more inclined to respond to this simplifed
version)
 
Hello Todd,

Why dont you takehttp://sulprobil.com/html/sort_vba.html
?

Regards,
Bernd
Click to expand...

I don't want to sort with secondary criteria. I want to sort by the
results of a calculation (the smaller date of 2 columns)

I have crude code to do it, but it is VERY SLOW because of the crude
sort routine and multiple cut/paste of rows during the sort......


Private Sub sort_cm_and_therapy_dates()
Dim temparray(200, 1) As Date

'get a rough sort on the first column to speed things up:
Cells.Sort Key1:=Range("L2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

RowCount = Sheets(Caseload_Tab).Cells(Rows.Count, 2).End(xlUp).Row
For x = 2 To RowCount
temparray(x, 0) = x
'when neither column has a date, skip it.:
If Not IsDate(Worksheets(Caseload_Tab).Cells(x, CM_Date_Column))
Then If Not IsDate(Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column)) Then GoTo donecomparing
'when there is no CM date, use the therapy date:
If Not IsDate(Worksheets(Caseload_Tab).Cells(x, CM_Date_Column))
Then temparray(x, 1) = Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column): GoTo donecomparing
'when there is no Therapy date, use the CM date:
If Not IsDate(Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column)) Then temparray(x, 1) = Worksheets
(Caseload_Tab).Cells(x, CM_Date_Column): GoTo donecomparing

'compare dates:
If Worksheets(Caseload_Tab).Cells(x, CM_Date_Column) < Worksheets
(Caseload_Tab).Cells(x, Therapy_Date_Column) Then temparray(x, 1) =
Worksheets(Caseload_Tab).Cells(x, CM_Date_Column) Else temparray(x, 1)
= Worksheets(Caseload_Tab).Cells(x, Therapy_Date_Column)
donecomparing:
Next x

'sort
For i = 2 To RowCount - 1
Application.StatusBar = Int(i / RowCount * 100) & "% Sorted"
For j = 2 To RowCount - 1
If temparray(j, 1) > temparray(j + 1, 1) Then
t = temparray(j, 1): temparray(j, 1) = temparray(j +
1, 1): temparray(j + 1, 1) = t
Rows(j + 1 & ":" & j + 1).Cut: Rows(j & ":" &
j).Insert Shift:=xlDown 'swap rows
End If
Next
Next
Application.StatusBar = ""
Call reprotectit
End Sub


Any help in speeding this up would be appreciated.
 
Why not use a temporary column that inserts the formula you like, sort the data
based on this column and then delete the column.

Heck, you could even leave that column there and just hide it if it bothered
you.
 
Your solution works perfectly. However, my challenge here is to do
this "off the grid" in order to preserve the format of the
spreadsheet. Here's the simple solution using cells....

Sub sort_cm_and_therapy_dates()
Call unprotectit
RowCount = Sheets(Caseload_Tab).Cells(Rows.Count, 2).End(xlUp).Row
For x = 2 To RowCount
Cells(x, sorting_column) = ""
'no dates:
If Not IsDate(Worksheets(Caseload_Tab).Cells(x, CM_Date_Column))
Then If Not IsDate(Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column)) Then GoTo donecomparing
'no CM date:
If Not IsDate(Worksheets(Caseload_Tab).Cells(x, CM_Date_Column))
Then Cells(x, sorting_column) = Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column): GoTo donecomparing
'no therapy date:
If Not IsDate(Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column)) Then Cells(x, sorting_column) = Worksheets
(Caseload_Tab).Cells(x, CM_Date_Column): GoTo donecomparing
'compare dates:
If Worksheets(Caseload_Tab).Cells(x, CM_Date_Column) < Worksheets
(Caseload_Tab).Cells(x, Therapy_Date_Column) Then Cells(x,
sorting_column) = Worksheets(Caseload_Tab).Cells(x, CM_Date_Column)
Else Cells(x, sorting_column) = Worksheets(Caseload_Tab).Cells(x,
Therapy_Date_Column)
donecomparing:
Next x
Cells.Sort Key1:=Range(sorting_column & "2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Range(sorting_column & "2", sorting_column & RowCount).ClearContents
Call reprotectit
End Sub
 
Back
Top