Results 1 to 9 of 9
  1. #1
    5 Star Lounger
    Join Date
    Dec 2009
    Location
    Pittsford,NY
    Posts
    874
    Thanks
    517
    Thanked 35 Times in 27 Posts

    sorting worksheets in a workbook

    I have an excel 2007 workbook made up of about 20 worksheets.
    Is there a way to sort the worksheets so that they are in alphabetical order?
    Thank you,
    Dick

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    How about the MS code at http://support.microsoft.com/kb/812386

    Steve

  3. The Following User Says Thank You to sdckapr For This Useful Post:

    Dick-Y (2014-04-23)

  4. #3
    5 Star Lounger
    Join Date
    Dec 2009
    Location
    Pittsford,NY
    Posts
    874
    Thanks
    517
    Thanked 35 Times in 27 Posts
    Steve:
    That article is prefaced as follows:
    "Note In Microsoft Office Excel 2007 and in earlier versions of Microsoft Excel, you cannot sort macro sheets because they are displayed in the Visual Basic Editor. "
    ??????????????????

    Dick

  5. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Dick,

    Here's some code I threw together you can try out. It seems to work for me.
    PreSort:
    presort.JPG
    PostSort:
    postsort.JPG
    Code:
    Option Explicit
    
    Sub TabSort()
    
       Dim zTabNames() As String
       Dim sht       As Worksheet
       Dim iShtCnt   As Integer
       Dim iCntr     As Integer
       
       iShtCnt = ActiveWorkbook.Sheets.Count
       ReDim zTabNames(iShtCnt)
       iCntr = 0
       
       For Each sht In ActiveWorkbook.Sheets
          zTabNames(iCntr) = sht.Name
          iCntr = iCntr + 1
       Next sht
       
       procSort zTabNames, "A"  'Note procSort returns a 1 based array!
    
       For iCntr = 1 To iShtCnt
          Sheets(zTabNames(iCntr)).Move After:=Sheets(iShtCnt)
       Next iCntr
     
    End Sub
    The above relies on the following QuickSort procedure which as you can see I did NOT write!

    Code:
    '***************************************************************************
    '*                                                                         *
    '* MODULE NAME:     QUICKSORT ALGORITHM DEMO                               *
    '* AUTHOR & DATE:   STEPHEN BULLEN,  Stephen@oaltd.co.uk                   *
    '*                                                                         *
    '* DESCRIPTION:     The Quicksort algorithm is one of the fastest that I   *
    '*                  know.  This sheet contains example quicksort routines  *
    '*                  for both 1D and 2D arrays.                             *
    '*                                                                         *
    '*                  To try it out, run the TestSort routine below.         *
    '*                                                                         *
    '***************************************************************************
    
    Option Base 1
    Option Explicit
    
    'Windows API calls to get a millisecond timer
    Declare Function wapiGetTickCount32 Lib "kernel32" Alias "GetTickCount" () As Long
    Declare Function wapiGetTickCount16 Lib "user" Alias "GetTickCount" () As Long
    
    'Test the Sorting algorithms.
    Sub TestSort()
    
    Dim oSht As Worksheet, iUpper As Integer, i As Integer, myArray As Variant
    Dim avOrig2D As Variant, avOrig1D() As Variant, dStart As Double
    
    'Freeze the screen
    Application.ScreenUpdating = False
    
    Set oSht = ThisWorkbook.Sheets("Sheet1")
    
    oSht.Calculate
    
    'Get the values from the sheet
    avOrig2D = oSht.Range("ptrOriginals").CurrentRegion.Value
    
    'How many are there?
    iUpper = UBound(avOrig2D, 1)
    
    'Copy the first column to a 1D array
    ReDim avOrig1D(1 To iUpper)
    For i = 1 To iUpper
        avOrig1D(i) = avOrig2D(i, 1)
    Next
    
    'Sort 1D Ascending and store in sheet
    myArray = avOrig1D
    dStart = funTicker
    procSort myArray, "A"
    With oSht.Range("ptr1DAsc")
        .Offset(-1, 0).Value = funTicker - dStart
        .Resize(iUpper, 1).Value = Application.Transpose(myArray)
    End With
    
    'Sort 1D Descending and store in sheet
    myArray = avOrig1D
    dStart = funTicker
    procSort myArray, "D"
    With oSht.Range("ptr1DDesc")
        .Offset(-1, 0).Value = funTicker - dStart
        .Resize(iUpper, 1).Value = Application.Transpose(myArray)
    End With
    
    'Sort 2D Ascending and store in sheet
    myArray = avOrig2D
    dStart = funTicker
    procSort myArray, "A"
    With oSht.Range("ptr2DAsc")
        .Offset(-1, 0).Value = funTicker - dStart
        .Resize(iUpper, 2).Value = myArray
    End With
    
    'Sort 2D Descending and store in sheet
    myArray = avOrig2D
    dStart = funTicker
    procSort myArray, "D"
    With oSht.Range("ptr2DDesc")
        .Offset(-1, 0).Value = funTicker - dStart
        .Resize(iUpper, 2).Value = myArray
    End With
    
    End Sub
    
    
    '***************************************************************************
    '*                                                                         *
    '* FUNCTION NAME:   SORT ARRAY                                             *
    '*                                                                         *
    '* DESCRIPTION:     Calculates the size of the passed array and if it is   *
    '*                  one or two dimensions.  Calls the appropriate sorting  *
    '*                  routine.                                               *
    '*                                                                         *
    '* PARAMETERS:      avArray   The array of values to sort                  *
    '*                  sOrder    A-Ascending, D-Descending                    *
    '*                  iKey      For 2D arrays, which column to sort on       *
    '*                                                                         *
    '***************************************************************************
    
    Sub procSort(avArray As Variant, sOrder As String, Optional iKey As Variant)
    
    Dim iLower As Integer, iUpper As Integer, iIdx As Integer, x As Variant
    
    'Trap if avArray is not an array
    On Error GoTo ErrNotArray
    
    'Find the size of the array
    iLower = LBound(avArray, 1)
    iUpper = UBound(avArray, 1)
    
    'Don't break on errors.  Easier to check if Err<>0
    On Error Resume Next
    
    'Reset the error number to show no error
    Err = 0
    
    'Try to get the size of the 2nd dimension.  1D arrays give an error
    x = UBound(avArray, 2)
    
    If Err <> 0 Then
        'If an error, sort a 1D array
        procSort1D avArray, sOrder, iLower, iUpper
    Else
        'If no error, check the column to sort by
        If IsMissing(iKey) Then
            iIdx = 1
        Else
            iIdx = iKey
        End If
        
        'Sort a 2D array
        procSort2D avArray, sOrder, iIdx, iLower, iUpper
    End If
    
    Exit Sub
    
    ErrNotArray:
    
    End Sub
    
    
    '***************************************************************************
    '*                                                                         *
    '* FUNCTION NAME:   SORT ARRAY - 2D                                        *
    '*                                                                         *
    '* DESCRIPTION:     Sorts the passed array into required order, using the  *
    '*                  given key.  The array must be a 2D array of any size.  *
    '*                                                                         *
    '* PARAMETERS:      avArray   The array of values to sort                  *
    '*                  sOrder    A-Ascending, D-Descending                    *
    '*                  iKey      The number of the column to sort on          *
    '*                  iLow1     The first item to sort between               *
    '*                  iHigh1    The last item to sort between                *
    '*                                                                         *
    '***************************************************************************
    
    Sub procSort2D(avArray, sOrder As String, iKey As Integer, iLow1 As Integer, iHigh1 As Integer)
    
    On Error Resume Next
    
    'Dimension variables
    Dim iLow2 As Integer, iHigh2 As Integer, i As Integer
    Dim vItem1, vItem2 As Variant
    
    'Set new extremes to old extremes
    iLow2 = iLow1
    iHigh2 = iHigh1
    
    'Get value of array item in middle of new extremes
    vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)
    
    'Loop for all the items in the array between the extremes
    While iLow2 < iHigh2
        
        If sOrder = "A" Then
            'Find the first item that is greater than the mid-point item
            While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
                iLow2 = iLow2 + 1
            Wend
    
            'Find the last item that is less than the mid-point item
            While avArray(iHigh2, iKey) > vItem1 And iHigh2 > iLow1
                iHigh2 = iHigh2 - 1
            Wend
        Else
            'Find the first item that is less than the mid-point item
            While avArray(iLow2, iKey) > vItem1 And iLow2 < iHigh1
                iLow2 = iLow2 + 1
            Wend
    
            'Find the last item that is greater than the mid-point item
            While avArray(iHigh2, iKey) < vItem1 And iHigh2 > iLow1
                iHigh2 = iHigh2 - 1
            Wend
        End If
    
        'If the two items are in the wrong order, swap the rows
        If iLow2 < iHigh2 Then
            For i = 1 To UBound(avArray, 2)
                vItem2 = avArray(iLow2, i)
                avArray(iLow2, i) = avArray(iHigh2, i)
                avArray(iHigh2, i) = vItem2
            Next
        End If
    
        'If the pointers are not together, advance to the next item
        If iLow2 <= iHigh2 Then
            iLow2 = iLow2 + 1
            iHigh2 = iHigh2 - 1
        End If
    Wend
    
    'Recurse to sort the lower half of the extremes
    If iHigh2 > iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2
    
    'Recurse to sort the upper half of the extremes
    If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1
    
    End Sub
    
    
    '***************************************************************************
    '*                                                                         *
    '* FUNCTION NAME:   SORT ARRAY - 1D                                        *
    '*                                                                         *
    '* DESCRIPTION:     Sorts the passed array into required order, using the  *
    '*                  given key.  The array must be a 1D array of any size.  *
    '*                                                                         *
    '* PARAMETERS:      avArray   The array of values to sort                  *
    '*                  sOrder    A-Ascending, D-Descending                    *
    '*                  iLow1     The first item to sort between               *
    '*                  iHigh1    The last item to sort between                *
    '*                                                                         *
    '***************************************************************************
    
    Sub procSort1D(avArray, sOrder As String, iLow1 As Integer, iHigh1 As Integer)
    
    On Error Resume Next
    
    'Dimension variables
    Dim iLow2 As Integer, iHigh2 As Integer, i As Integer
    Dim vItem1, vItem2 As Variant
    
    'Set new extremes to old extremes
    iLow2 = iLow1
    iHigh2 = iHigh1
    
    'Get value of array item in middle of new extremes
    vItem1 = avArray((iLow1 + iHigh1) \ 2)
    
    'Loop for all the items in the array between the extremes
    While iLow2 < iHigh2
        
        If sOrder = "A" Then
            'Find the first item that is greater than the mid-point item
            While avArray(iLow2) < vItem1 And iLow2 < iHigh1
                iLow2 = iLow2 + 1
            Wend
    
            'Find the last item that is less than the mid-point item
            While avArray(iHigh2) > vItem1 And iHigh2 > iLow1
                iHigh2 = iHigh2 - 1
            Wend
        Else
            'Find the first item that is less than the mid-point item
            While avArray(iLow2) > vItem1 And iLow2 < iHigh1
                iLow2 = iLow2 + 1
            Wend
    
            'Find the last item that is greater than the mid-point item
            While avArray(iHigh2) < vItem1 And iHigh2 > iLow1
                iHigh2 = iHigh2 - 1
            Wend
        End If
    
        'If the two items are in the wrong order, swap the rows
        If iLow2 < iHigh2 Then
            vItem2 = avArray(iLow2)
            avArray(iLow2) = avArray(iHigh2)
            avArray(iHigh2) = vItem2
        End If
    
        'If the pointers are not together, advance to the next item
        If iLow2 <= iHigh2 Then
            iLow2 = iLow2 + 1
            iHigh2 = iHigh2 - 1
        End If
    Wend
    
    'Recurse to sort the lower half of the extremes
    If iHigh2 > iLow1 Then procSort1D avArray, sOrder, iLow1, iHigh2
    
    'Recurse to sort the upper half of the extremes
    If iLow2 < iHigh1 Then procSort1D avArray, sOrder, iLow2, iHigh1
    
    End Sub
    
    
    '***************************************************************************
    '*                                                                         *
    '* FUNCTION NAME:   WINDOWS TICK COUNT                                     *
    '*                                                                         *
    '* DESCRIPTION:     Windows has a clock ticking over every 1/1000th of a   *
    '*                  second.  This function returns the number of seconds   *
    '*                  since Windows was started.                             *
    '*                                                                         *
    '***************************************************************************
    
    Function funTicker() As Double
    
    'Use either 16-bit or 32-bit API call
    If Application.OperatingSystem Like "*32*" Then
        funTicker = wapiGetTickCount32 / 1000
    Else
        funTicker = wapiGetTickCount16 / 1000
    End If
    
    End Function
    HTH
    Last edited by RetiredGeek; 2014-04-22 at 16:36.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  6. The Following User Says Thank You to RetiredGeek For This Useful Post:

    Dick-Y (2014-04-22)

  7. #5
    Lounger akjudge's Avatar
    Join Date
    Jan 2014
    Posts
    41
    Thanks
    1
    Thanked 8 Times in 7 Posts
    Dick,

    I know a way to do this in Excel 2007, but it only works in an opened workbook. First open the workbook where you want to do the sorting in. Then follow the steps below:

    Step 1: Hold down the ALT + F11 keys, and it opens the Microsoft Visual Basic for Applications window.

    Step 2: Click Insert > Module, and then paste the following macro in the Module Window.

    Sub Sort_Active_Book()
    Dim i As Integer
    Dim j As Integer
    Dim iAnswer As VbMsgBoxResult
    iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
    & "Clicking No will sort in Descending Order", _
    vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
    For i = 1 To Sheets.Count
    For j = 1 To Sheets.Count - 1
    If iAnswer = vbYes Then
    If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
    Sheets(j).Move After:=Sheets(j + 1)
    End If
    ElseIf iAnswer = vbNo Then
    If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
    Sheets(j).Move After:=Sheets(j + 1)
    End If
    End If
    Next j
    Next i
    End Sub

    Step 3: Don't save or anything else -- just immediately press the F5 key to run this macro. This will take you back to your workbook and display a Sort Worksheets prompt box. In the prompt box, click Yes, and all the worksheets will be sorted by ascending alphabetical order. Or click No, and all the worksheets will be sorted by descending alphabetical order.

    Close the Visual Basic Window, then save your workbook to save the changes.

    I think you can save the macro to run in other workbooks, but it involves making changes to how macros are enabled in the Trust Center. I chose not to enable this macro across the board since it is so easy to recreate when I need to run it. (I just save these instructions as a text file, then copy the macro lines and paste them in the Module Window when I need to run this particular macro).

    Hope this helps...

    Jim

  8. The Following User Says Thank You to akjudge For This Useful Post:

    Dick-Y (2014-04-22)

  9. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Macro sheets are a special type of sheet (pre-Visual Basic), which you shouldn't have in an XL2007 workbook...

    Steve

  10. #7
    5 Star Lounger
    Join Date
    Dec 2009
    Location
    Pittsford,NY
    Posts
    874
    Thanks
    517
    Thanked 35 Times in 27 Posts
    RG:
    Thanks. I couldn't figure out how to run what you posted.
    Jim:
    Thank you very much. Your method worked perfectly; and, the way you explained everything, even I could follow it.
    My problem is that I'm lucky if I can spell "VBA."
    Best,
    Dick

  11. #8
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,641
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Dick-Y,

    How about a simple bubble sort?

    HTH,
    Maud

    Code:
    Public Sub SortSheets()
    '--------------------------------
    'DECALRE AND SET VARIABLES
    Dim s() As Variant
    Dim I As Integer, J As Integer
    num = Worksheets.Count
    ReDim s(num)
    '--------------------------------
    'SORT SHEETS
    For I = 1 To num:: s(I) = Worksheets(I).Name:: Next I
    For I = 1 To num - 1
        For J = I + 1 To num
            If s(I) > s(J) Then
                sht = s(I):: s(I) = s(J):: s(J) = sht
            End If
        Next J
    Next I
    For I = 1 To num:: Worksheets(s(I)).Move before:=Worksheets(I):: Next I
    End Sub
    1. ALT + F11 keys to open Microsoft Visual Basic Editor.
    2. Insert > Module then paste the above macro in the Module Window. You can close the editor if you wish.
    3. In Excel, click the Developer Tab> Macros> select "SortSheets> click run.
    4. If you click options while in the macro window, you can set a shortcut to run the macro

  12. The Following User Says Thank You to Maudibe For This Useful Post:

    Dick-Y (2014-04-23)

  13. #9
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Dick,

    Same steps as Jim's example except there are to code boxes to paste. They can both go into the same modules or different modules doesn't matter. Sorry I didn't specify initially. HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  14. The Following User Says Thank You to RetiredGeek For This Useful Post:

    Dick-Y (2014-04-23)

Tags for this Thread

Posting Permissions

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