?
Solved

Sort Excel Worksheets in alphabetical order within given two sheets

Posted on 2012-03-17
4
Medium Priority
?
417 Views
Last Modified: 2012-03-20
I have a work book with multiple worksheets. In that worksheet there are two tabs "Start_Tab" and "End_Tab". There are several worksheets between those two tabs. All the tabs within the two worksheets "Start_Tab" and "End_Tab" are in a haphazard manner and need to be sorted in an alphabetical order.
Only those tabs between "Start_Tab" and "End_Tab" need to be sorted, not the entire workbook.

I had tried the following code to sort the worksheets, but it is sorting ALL the tabs in the worksheet, but not restricting only to the tabs between "Start_tab" and "End_Tab".
Could some one please suggest a VBA Code?
My code is as below



Sub SortWorksheets()
     
    Dim N As Integer
    Dim M As Integer
    Dim FirstWSToSort As Integer
    Dim LastWSToSort As Integer
    Dim SortDescending As Boolean
     
    SortDescending = False
     
    If ActiveWindow.SelectedSheets.Count = 1 Then
         
         'Change the 1 to the worksheet you want sorted first
        FirstWSToSort = 1
        LastWSToSort = Worksheets.Count
    Else
        With ActiveWindow.SelectedSheets
            For N = 2 To .Count
                If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next N
            FirstWSToSort = .Item(1).Index
            LastWSToSort = .Item(.Count).Index
            MsgBox .Item(1).Index
             MsgBox .Item(.Count).Index
        End With
    End If
   
   
'  Exit Sub
     
    For M = FirstWSToSort To LastWSToSort
        For N = M To LastWSToSort
           
            If SortDescending = True Then
                If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            Else
                If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            End If
           
           
        Next N
    Next M
     
End Sub
0
Comment
Question by:vsuripeddi
  • 2
  • 2
4 Comments
 

Author Comment

by:vsuripeddi
ID: 37732482
Please suggest VBA Code
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 37732614
Hi,

Sub kTest()
    
    Dim t, i    As Long
    Dim j       As Long
    Dim n       As Long
    Dim s()     As String
    Dim Flg     As Boolean
    
    For i = 1 To Worksheets.Count
        If Not Flg Then
            If LCase$(Worksheets(i).Name) = "start_tab" Then
                Flg = True
                GoTo Nxt
            End If
        ElseIf LCase$(Worksheets(i).Name) = "end_tab" Then
            Exit For
        Else
            n = n + 1
            ReDim Preserve s(1 To n)
            s(n) = UCase$(Worksheets(i).Name)
        End If
Nxt:
    Next
    
    For i = 1 To n
        For j = i To n
            If CStr(s(j)) < CStr(s(i)) Then
                Worksheets(CStr(s(j))).Move before:=Worksheets(CStr(s(i)))
                t = s(j)
                s(j) = s(i)
                s(i) = t
            End If
        Next
    Next
        
End Sub

Open in new window


Kris
0
 

Author Comment

by:vsuripeddi
ID: 37739021
Kris

Thanks a lot for your comment.
Your code works and I am delighted to have this code from you.

There is a small issue howver.
This is taking a very long time to do the sorting and this sort process should take 4 - 5 seconds. Could you suggest a faster way to do the sorting?

thanks
0
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 2000 total points
ID: 37740355
Hi

Sub kTest()
    
    Dim t, i    As Long
    Dim j       As Long
    Dim n       As Long
    Dim s()     As String
    Dim Flg     As Boolean
    Dim Calc    As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        Calc = .Calculation
        .Calculation = xlCalculationManual
    End With
    
    For i = 1 To Worksheets.Count
        If Not Flg Then
            If LCase$(Worksheets(i).Name) = "start_tab" Then
                Flg = True
                GoTo Nxt
            End If
        ElseIf LCase$(Worksheets(i).Name) = "end_tab" Then
            Exit For
        Else
            n = n + 1
            ReDim Preserve s(1 To n)
            s(n) = UCase$(Worksheets(i).Name)
        End If
Nxt:
    Next
    
    For i = 1 To n
        For j = i To n
            If CStr(s(j)) < CStr(s(i)) Then
                Worksheets(CStr(s(j))).Move before:=Worksheets(CStr(s(i)))
                t = s(j)
                s(j) = s(i)
                s(i) = t
            End If
        Next
    Next
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = Calc
    End With
    
End Sub

Open in new window


Kris
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

755 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question