Solved

Sort Excel Worksheets in alphabetical order within given two sheets

Posted on 2012-03-17
4
404 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 500 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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Suggested Solutions

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

707 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now