Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
wacky sort order question
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) |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
wacky sort order question
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
wacky sort order question
On Jul 1, 5:03*pm, Bernd P wrote:
Hello Todd, Why dont you takehttp://sulprobil.com/html/sort_vba.html ? Regards, Bernd 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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
wacky sort order question
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. Jabberwocky wrote: On Jul 1, 5:03 pm, Bernd P wrote: Hello Todd, Why dont you takehttp://sulprobil.com/html/sort_vba.html ? Regards, Bernd 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. -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
wacky sort order question
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 On Aug 3, 3:53*pm, Dave Peterson wrote: 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. Jabberwocky wrote: On Jul 1, 5:03 pm, Bernd P wrote: Hello Todd, Why dont you takehttp://sulprobil.com/html/sort_vba.html ? Regards, Bernd 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. -- Dave Peterson- Hide quoted text - - Show quoted text - |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Retaining Sort order in the Sort Dialog box | Excel Discussion (Misc queries) | |||
Sort sheet based on particuilar sort order | Excel Worksheet Functions | |||
Wacky Little IF Structure | Excel Discussion (Misc queries) | |||
Pls. reply Sort Data and copy to next coulmn when sort order chang | Excel Programming | |||
Wacky form | Excel Programming |