Solved

Sort Excel Worksheets in alphabetical order within given two sheets

Posted on 2012-03-17
4
412 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Salesforce Made Easy to Use

On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.

Question has a verified solution.

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

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

733 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