Sort Excel Worksheets in alphabetical order within given two sheets

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
vsuripeddiAsked:
Who is Participating?
 
krishnakrkcConnect With a Mentor Commented:
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
 
vsuripeddiAuthor Commented:
Please suggest VBA Code
0
 
krishnakrkcCommented:
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
 
vsuripeddiAuthor Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.