Page 1 of 2 12 LastLast
Results 1 to 15 of 17
  1. #1
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts
    A toy.
    Enjoy.

    [pre]Public Function SwitchWorksheets(wbk As Workbook)
    Dim lng As Long
    For lng = 1 To wbk.Worksheets.Count - 1
    If wbk.Worksheets(lng).Name > wbk.Worksheets(lng + 1).Name Then
    wbk.Worksheets(lng + 1).Move before:=wbk.Worksheets(lng)
    Call SwitchWorksheets(wbk)
    Else
    End If
    Next lng
    'Sub TESTSwitchWorksheets()
    ' Call SwitchWorksheets(ActiveWorkbook)
    'End Sub
    End Function[/pre]

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    [quote name='chrisgreaves' post='761464' date='26-Feb-09 02:49']A toy.
    Enjoy.

    [pre]Public Function SwitchWorksheets(wbk As Workbook)
    Dim lng As Long
    For lng = 1 To wbk.Worksheets.Count - 1
    If wbk.Worksheets(lng).Name > wbk.Worksheets(lng + 1).Name Then
    wbk.Worksheets(lng + 1).Move before:=wbk.Worksheets(lng)
    Call SwitchWorksheets(wbk)
    Else
    End If
    Next lng
    'Sub TESTSwitchWorksheets()
    ' Call SwitchWorksheets(ActiveWorkbook)
    'End Sub
    End Function[/pre][/quote]Wot - no QucikSort??!!?
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    QuickSort to sort 15 worksheets or so?

  4. #4
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='macropod' post='761639' date='25-Feb-09 20:19']Wot - no QucikSort??!!?[/quote]

    Well, if you were to try renaming your worksheets to be "Q", "u", "i", "c", "k", "S", "o", "r, "t", it'd be a start (Huge pedantic grin!)

  5. #5
    Silver Lounger
    Join Date
    Jul 2001
    Location
    Ottawa, Ontario, Canada
    Posts
    1,609
    Thanks
    0
    Thanked 1 Time in 1 Post
    [quote name='chrisgreaves' post='761464' date='25-Feb-09 10:49']A toy.
    Enjoy.[/quote]
    Chris
    It would appear that some of our learned friends are using the needle on you. However I would like to thank you for this post as I have for some time been using bubble sorts and wondering where to find a more efficient algorithm. It would seem that Hans and Paul have provided the clue I needed.
    Good on ya Mate.
    Regards
    Don

  6. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Hi Don,

    There's a good Quicksort implementation here:http://en.allexperts.com/q/Excel-1059/2008...nal-array-1.htm. I've used it myself to to implement nested sorting on a 4-column two-dimension array, calling the QuickSort sub with:
    Code:
    Sub NestedSort()
    Dim SortCol1 As Integer
    Dim SortCol2 As Integer
    Dim SortCol3 As Integer
    Dim SortCol4 As Integer
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim m As Long
    Dim n As Long
    SortCol1 = 4
    SortCol2 = 1
    SortCol3 = 2
    SortCol4 = 3
    QuickSort DataArray, SortCol1, LBound(DataArray), UBound(DataArray)
    If SortCol2 <> 0 Then
      j = LBound(DataArray)
      For i = j To UBound(DataArray) + 1
    	If DataArray(i, SortCol1) <> DataArray(i + 1, SortCol1) Then
    	  QuickSort DataArray, SortCol3, j, I
    	  If SortCol3 <> 0 Then
    		l = j
    		For k = l To i + 1
    		  If DataArray(k, SortCol3) <> DataArray(k + 1, SortCol3) Then
    			QuickSort DataArray, SortCol2, l, k
    			If SortCol4 <> 0 Then
    			  n = l
    			  For m = n To k + 1
    				If DataArray(m, SortCol2) <> DataArray(m + 1, SortCol2) Then
    				  QuickSort DataArray, SortCol4, n, m
    				  n = m + 1
    				End If
    			  Next m
    			End If
    			l = k + 1
    		  End If
    		Next k
    	  End If
    	  j = i + 1
    	End If
      Next I
    End If
    End sub
    With the above code, the data are first sorted on the column defined by SortCol1, then by each of SortCol2-4 in turn until the code encounters a SortCol# with a value of 0. The nesting can be extended for more sort columns, if necessary.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  7. #7
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Post

    [quote name='wdwells' post='762096' date='27-Feb-09 00:02']It would appear that some of our learned friends are using the needle on you.[/quote] [disbelief]NO![/disbelief] Hi Don, Macropod, Hans, Skitterbug, Jezza Old Uncle Tom Cobleigh, Sally, the man at the dry-cleaners across the road, the driver of the 82N express bus, ... ...

    You are all quite correct, as am I (ahem!). I regularly use a little Qsort which I borrowed from a BBS forum back in '96 and forgot to return.

    In this instance I did not want to use my 800-function VBA library, in which QSort resides, because it would be overkill.
    I decided not to copy/paste QSort into the code because I felt that loading all the names to a string array just so I could pass it to a function was going to make the code more complicated than it need to be ("Confusauser").
    Using the sledge-hammer approach seemed, to me, to crack the nut in one blow without needing much swinging room.

    Actually, to be perfectly honest, I am so happy with the code I am going to include it in my beginners Excel VBA class.
    As might you all

  8. #8
    Silver Lounger
    Join Date
    Jul 2001
    Location
    Ottawa, Ontario, Canada
    Posts
    1,609
    Thanks
    0
    Thanked 1 Time in 1 Post
    [quote name='macropod' post='762098' date='26-Feb-09 22:19']Hi Don,

    There's a good Quicksort implementation here:http://en.allexperts.com/q/Excel-1059/2008...nal-array-1.htm. I've used it myself to to implement nested sorting on a 4-column two-dimension array, calling the QuickSort sub with:
    Sub NestedSort()
    .
    See original post for code.
    .
    End sub
    With the above code, the data are first sorted on the column defined by SortCol1, then by each of SortCol2-4 in turn until the code encounters a SortCol# with a value of 0. The nesting can be extended for more sort columns, if necessary.[/quote]
    Thank you Paul
    I am certainly going to play with this.
    Regards
    Don

  9. #9
    5 Star Lounger
    Join Date
    Apr 2003
    Location
    Hampshire, United Kingdom
    Posts
    602
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Sorting worksheets within a workbook is one of the many functions available with the free ASAP Utilities add-in. If you haven't tried it before, I highly recommend it.
    Waggers
    If at first you do succeed, you&#39;ve probably missed something.

  10. #10
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='Waggers' post='762238' date='27-Feb-09 13:11']the free ASAP Utilities add-in[/quote]
    Thanks Waggers, I love addins, libraries etc but in this case the client wants a plain standalone system. They are averse to fancy stuff, anything that even hints at saving time & money etc.
    As I noted too, in an Excel/VBA raining class (the snow is now melting in Toronto) I look for unadorned exercises.

    Place me firmly in the group of believers in NOT reinventing the wheel!

  11. #11
    Silver Lounger
    Join Date
    Jul 2001
    Location
    Ottawa, Ontario, Canada
    Posts
    1,609
    Thanks
    0
    Thanked 1 Time in 1 Post
    [quote name='macropod' post='762098' date='26-Feb-09 22:19']Hi Don,

    There's a good Quicksort implementation here:http://en.allexperts.com/q/Excel-1059/2008...nal-array-1.htm. I've used it myself to to implement nested sorting on a 4-column two-dimension array, calling the QuickSort sub with:
    Sub NestedSort()
    .
    See original post for code.
    .
    End sub
    With the above code, the data are first sorted on the column defined by SortCol1, then by each of SortCol2-4 in turn until the code encounters a SortCol# with a value of 0. The nesting can be extended for more sort columns, if necessary.[/quote]

    Hi Paul
    I have been unable to get your NestedSort code to compile. Might I impose on you to create a small table in Excel and embed the code in the same workbook si order that I can step through the code. Many thanks in advance.
    Regards
    Don

  12. #12
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    [quote name='wdwells' post='762374' date='28-Feb-09 14:58']Hi Paul
    I have been unable to get your NestedSort code to compile. Might I impose on you to create a small table in Excel and embed the code in the same workbook si order that I can step through the code. Many thanks in advance.[/quote]
    Hi Don,

    It's a long time since I used the code, and I no longer have the data source. From (vague) memory it wasn't an Excel worksheet, though. Be that as it may, here's a working implementation with a couple of loops to populate a 4X4 array and to capture & display the pre- and post- sort orders. I had to tweak the code a bit, but it seems to work OK:
    Code:
    Sub QuickSort(SortArray, col, L, H)
    'Sorts on the nominated column of a two-dimension array
    'Usage: Quicksort(Array to Sort, Column to Sort on, Lowest Row, Highest Row)
    
    'Originally Posted by Jim Rech 10/20/98 Excel.Programming
    'Modifications by Tom Ogilvy
    'Modified to sort on first column of a two dimensional array
    'Modified to handle a second dimension greater than 1 (or zero)
    'Further variable-parameter name mods for clarity by macropod
    
    Dim i, j, X, Y, mm
    i = L
    j = H
    X = SortArray((L + H) / 2, col)
    While (i <= j)
      While (SortArray(i, col) < X And i < H)
    	i = i + 1
      Wend
      While (X < SortArray(j, col) And j > L)
    	j = j - 1
      Wend
      If (i <= j) Then
    	For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
    	  Y = SortArray(i, mm)
    	  SortArray(i, mm) = SortArray(j, mm)
    	  SortArray(j, mm) = Y
    	Next mm
    	i = i + 1
    	j = j - 1
      End If
    Wend
    If (L < j) Then Call QuickSort(SortArray, col, L, j)
    If (i < H) Then Call QuickSort(SortArray, col, i, H)
    End Sub
    
    Sub NestedSort()
    Dim DataArray(4, 4)
    Dim TmpList As String
    Dim SortCol1 As Integer
    Dim SortCol2 As Integer
    Dim SortCol3 As Integer
    Dim SortCol4 As Integer
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim L As Long
    Dim m As Long
    Dim n As Long
    SortCol1 = 4
    SortCol2 = 1
    SortCol3 = 2
    SortCol4 = 3
    For i = 0 To 4
      For j = 0 To 4
    	DataArray(i, j) = -(i ^ j)
    	TmpList = TmpList & DataArray(i, j) & ","
      Next
      TmpList = TmpList & vbCr
    Next
    QuickSort DataArray, SortCol1, LBound(DataArray), UBound(DataArray)
    If SortCol2 <> 0 Then
      j = LBound(DataArray)
      For i = j To UBound(DataArray) - 1
    	If DataArray(i, SortCol1) <> DataArray(i + 1, SortCol1) Then
    	  QuickSort DataArray, SortCol3, j, i
    	  If SortCol3 <> 0 Then
    		L = j
    		For k = L To i
    		  If DataArray(k, SortCol3) <> DataArray(k + 1, SortCol3) Then
    			QuickSort DataArray, SortCol2, L, k
    			If SortCol4 <> 0 Then
    			  n = L
    			  For m = n To k
    				If DataArray(m, SortCol2) <> DataArray(m + 1, SortCol2) Then
    				  QuickSort DataArray, SortCol4, n, m
    				  n = m + 1
    				End If
    			  Next m
    			End If
    			L = k + 1
    		  End If
    		Next k
    	  End If
    	  j = i + 1
    	End If
      Next i
    End If
    TmpList = TmpList & vbCr
    For i = 0 To 4
      For j = 0 To 4
    	TmpList = TmpList & DataArray(i, j) & ","
      Next
      TmpList = TmpList & vbCr
    Next
    MsgBox TmpList
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  13. #13
    Silver Lounger
    Join Date
    Jul 2001
    Location
    Ottawa, Ontario, Canada
    Posts
    1,609
    Thanks
    0
    Thanked 1 Time in 1 Post
    Thanks Paul
    Now that I have something that compiles, I can play with it and gain an understanding.
    Regards
    Don

  14. #14
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    [quote name='wdwells' post='762406' date='01-Mar-2009 00:45']Thanks Paul
    Now that I have something that compiles, I can play with it and gain an understanding.[/quote]Hi Don,

    I believe the only reason the code wasn't compiling before is that, when I used it, the 'SortArray' array variable was defined as public and the array had been defined by another process. Unfortunately, I can't remember the details.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  15. #15
    Silver Lounger
    Join Date
    Jul 2001
    Location
    Ottawa, Ontario, Canada
    Posts
    1,609
    Thanks
    0
    Thanked 1 Time in 1 Post
    [quote name='macropod' post='762581' date='01-Mar-2009 06:18']Hi Don,

    I believe the only reason the code wasn't compiling before is that, when I used it, the 'SortArray' array variable was defined as public and the array had been defined by another process. Unfortunately, I can't remember the details.[/quote]
    Hi Paul
    I think that when you test your 'NestedSort' you will find that it fails because 'QuickSort' does not respect any previous sorting. I believe that you will find the code in the attached workbook overcomes this shortfall.
    If you place the cursor anywhere within the range $A$1:$E$16 and set the constants at the beginning of the TEST_qsort procedure; the sorted results will be provided at $I$1:$M$16.
    Thanks for the nudge to think this one through.
    Attached Files Attached Files
    Regards
    Don

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •