Macro to sort worksheets

ahasija2s

New Member
Joined
Jul 15, 2019
Messages
5
Hello!
I am trying to write a VBA macro which would sort the worksheets according to the names. For example, sheets containing the word "Termed" should be placed at the end. I have included an example. In the example, "b-termed" worksheet should be placed at the end. I don't have a lot of background in VBA macros, so any help would be great! Thanks!

Worksheet names:
a
b-termed
c
d
e
f
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Try this macro:
Code:
Public Sub Sort_Sheets_In_2_Groups()

    Dim i As Long
    Dim group1Names() As String, group2Names() As String
    Dim n1 As Long, n2 As Long
    
    n1 = 0: n2 = 0
    
    With ActiveWorkbook
    
        For i = 1 To .Sheets.Count
            If InStr(1, .Sheets(i).Name, "termed", vbTextCompare) Then
                ReDim Preserve group2Names(n2)
                group2Names(n2) = .Sheets(i).Name
                n2 = n2 + 1
            Else
                ReDim Preserve group1Names(n1)
                group1Names(n1) = .Sheets(i).Name
                n1 = n1 + 1
           End If
        Next
    
        BubbleSort group1Names
        BubbleSort group2Names
    
        For i = 0 To UBound(group1Names)
            .Sheets(group1Names(i)).Move Before:=.Sheets(i + 1)
        Next
        
        For i = 0 To UBound(group2Names)
            .Sheets(group2Names(i)).Move Before:=.Sheets(UBound(group1Names) + i + 2)
        Next
    
    End With
    
End Sub


Private Sub BubbleSort(data As Variant)

    'Sort a one-dimensional string array
    
    Dim i As Long, j As Long
    Dim temp As String
    
    For i = LBound(data) To UBound(data) - 1
        For j = i + 1 To UBound(data)
            If data(i) > data(j) Then              'ascending order
                temp = data(i)
                data(i) = data(j)
                data(j) = temp
            End If
        Next
    Next
     
End Sub
 
Upvote 0
Thanks! I ended up doing this and it seems to do the trick:

Sub SortWorkbook()
Application.ScreenUpdating = False
Dim xResult As VbMsgBoxResult
xTitleId = "Sort Worksheets"
xResult = MsgBox("Sort Sheets according to termed groups?", vbYesCancel + vbQuestion + vbDefaultButton1, xTitleId)


For i = 1 To Application.Sheets.Count
For j = 1 To Application.Sheets.Count - 1
If Right(Trim(Application.Sheets(j).Name), 7) = "-termed" Then
Sheets(j).Move after:=Sheets(j + 1)
End If
Next j
Next i


Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top