VBA Macro To Rearrange 150 Sheets Based on a List in a Column

Jambi46n2

Board Regular
Joined
May 24, 2016
Messages
243
Office Version
365, 2019
Platform
Windows
I have 150 sheets inside 1 workbook, they need to be ordered exactly as listed in a column on a separate sheet.

Example (SheetA, SheetB, SheetC, ect)

These sheets have been renamed, and every macro I've found online is re-ordering based on the "Sheets Property (Name)" not by the actual naming convention listed in Excel.

I was hoping the code below would work, but it shorts by the property of the sheet, not the actual sheet name.

Any suggestions are greatly appreciated.

Thank you!

Code:
Sub SortWS()
' Assumes Source Listing is Already sorted
' If source Listing is not sorted additional coding will be
' needed to sort the source listing first
' There is no error checking so if the sheet name does not match the source list
' you will get an error if it attempts to move a sheet that doesnt exist


Dim ActiveWB As String
ActiveWB = ActiveWorkbook.Name                                                  'Capture Active Workbook Name
Dim SourceWB As Workbook
Dim SourceSH As String


Application.ScreenUpdating = False                                              'Turn ScreenUpdating OFf so its transparent


Set SourceWB = Workbooks.Open("F:\Finance Projects\BizNet Report\Chris\lists.xlsx", False, True)                      'Set the Source workbook Change the file Location
SourceSH = "Sheet1"                                                              'Set the Source Sheet Name


LastRow = SourceWB.Worksheets(SourceSH).Cells(Rows.Count, "A").End(xlUp).Row    'Determines Last Row based on column A if the names are a different column change A to appropriate column
ReDim SheetNames(LastRow)                                                       'Sets Array based on Number of Sheets
For T = 1 To LastRow
    SheetNames(T) = SourceWB.Worksheets(SourceSH).Cells(T, 1)                   'Read the sheet names in based on the Sourcesheet.  Assumes names are in Column A on source sheet Change the 1 to appropriate column
Next T
SourceWB.Close False                                                            ' close the source workbook without saving changes


Workbooks(ActiveWB).Activate                                                    'Make Sure workbook is active
Application.ScreenUpdating = True                                               'Turn Screen Updating on


For I = 1 To LastRow
For T = I To LastRow


If SheetNames(T) < Worksheets(I).Name Then Worksheets(SheetNames(T)).Move Before:=Worksheets(I)
Next T
Next I


End Sub
 
Last edited:

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,641
If you replace Worksheets(i).Name with Worksheets(i).CodeName, it should work the way you want.
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,641
Code:
These sheets have been renamed, and every macro I've found online is re-ordering based on the "Sheets Property (Name)" not by the actual naming convention listed in Excel.

I was hoping the code below would work, but it shorts by the property of the sheet, not the actual sheet name.
I think you are looking for the codename property of the sheets. The Code Name is given when the sheet is created, doesn't change and is found in the .CodeName property of a Sheet object. The Tab Name is what appears on the screen, can be changed by the user and is found in the .Name property of a Sheet object.

This link explains the different ways to refer to sheets, https://www.mrexcel.com/forum/excel...ksheets-info-reference-loop-add-etcetera.html

As to sorting according to a given list, this routine will do that.
The initial sections to assign the range of cells with the list and and the book whose sheets are to be reorder should be adjusted to match your situation.
NOTE: the function SheetCodeNamed acceses the .VBProject property of a workbook and your permissions may be set to forbid such access. IF that is the case, the AltSheetCodeNamed function should be used. (Its a little slower.)

Code:
Sub SortByList()
    Dim rngListOfNames As Range, arrListOfNames
    Dim wbBookToReorder As Workbook
    Dim wsSheetToMove As Worksheet
    Dim i As Long
    
    Rem set workbook whose sheets are to be re-ordered
    Set wbBookToReorder = Workbooks("Workbook1.xlsm")
    
    Rem set workbook with list of sheets
    With Workbooks("Workbook2.xlsm").Sheets("Sheet1")
        Set rngListOfNames = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
    End With
        ' if re-ordering the list (e.g. alphabetic sorting) is desired, do it here
    arrListOfNames = Application.Transpose(rngListOfNames.Value)
    
    Application.ScreenUpdating = False
    
    Rem sort the sheets according to list
    For i = UBound(arrListOfNames) To LBound(arrListOfNames) Step -1
        Set wsSheetToMove = SheetCodeNamed(arrListOfNames(i), wbBookToReorder)
        If Not wsSheetToMove Is Nothing Then
            wsSheetToMove.Move before:=wbBookToReorder.Sheets(1)
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub

Function SheetCodeNamed(SheetCodeName As Variant, wb As Workbook) As Worksheet
    On Error Resume Next
    With wb
        Set SheetCodeNamed = .Sheets(.VBProject.VBComponents(SheetCodeName).Properties("index"))
    End With
    On Error GoTo 0
End Function

Function AltSheetCodeNamed(SheetCodeName As Variant, wb As Workbook) As Worksheet
    Dim oneSheet As Worksheet
    For Each oneSheet In wb.Sheets
        If LCase(oneSheet.CodeName) = LCase(SheetCodeName) Then
            Set AltSheetCodeNamed = oneSheet
            Exit Function
        End If
    Next oneSheet
End Function
Note that SortByList will put the sheets in the order of the list, whatever that order is.

If you want the sheets to be ordered alphabeticaly, a shorter code will do that, no list required. (No SheetCodeNamed function needed either)
Code:
Sub SortSheetsAlphabeticalyByCodeName()
    Dim wbBookToSort As Workbook
    Dim i As Long, j As Long
    
    Set wbBookToSort = Workbooks("Workbook1.xlsm")
    Application.ScreenUpdating = False
    
    With wbBookToSort
        For i = 2 To .Sheets.Count
            For j = 1 To i - 1
                If .Sheets(i).CodeName < .Sheets(j).CodeName Then
                    .Sheets(i).Move before:=.Sheets(j)
                End If
            Next j
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub
 

Jambi46n2

Board Regular
Joined
May 24, 2016
Messages
243
Office Version
365, 2019
Platform
Windows
Thank you both for the prompt reply.

Unfortunately, I've had no luck with the code suggestions above.

The objective is to arrange the sheets by the actual sheet name displayed in the excel tab, not the property (Name).

They aren't listed alphabetically, they need to be arranged specifically to a separate workbook in column A which lists all the sheet names (tab names).

I appreciate the assistance.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,880
Office Version
365
Platform
Windows
Is this what you want.
Code:
Sub SortWS()
   Dim ActiveWB As Workbook, SourceWB As Workbook
   Dim Ary As Variant
   Dim i As Long

   Application.ScreenUpdating = False
   Set ActiveWB = ActiveWorkbook
   Set SourceWB = Workbooks.Open("c:\Mrexcel\+book1.xlsm") '("F:\Finance Projects\BizNet Report\Chris\lists.xlsx", False, True)
   
   With SourceWB.Worksheets("Sheet1")
      Ary = .Range("A2", Range("A" & Rows.Count).End(xlUp)).Value2
   End With
   SourceWB.Close False
   
   With ActiveWB
      For i = 1 To UBound(Ary)
         .Sheets(Ary(i, 1)).Move .Sheets(i)
      Next i
   End With
End Sub
 

Jambi46n2

Board Regular
Joined
May 24, 2016
Messages
243
Office Version
365, 2019
Platform
Windows
Is this what you want.
Code:
Sub SortWS()
   Dim ActiveWB As Workbook, SourceWB As Workbook
   Dim Ary As Variant
   Dim i As Long

   Application.ScreenUpdating = False
   Set ActiveWB = ActiveWorkbook
   Set SourceWB = Workbooks.Open("c:\Mrexcel\+book1.xlsm") '("F:\Finance Projects\BizNet Report\Chris\lists.xlsx", False, True)
   
   With SourceWB.Worksheets("Sheet1")
      Ary = .Range("A2", Range("A" & Rows.Count).End(xlUp)).Value2
   End With
   SourceWB.Close False
   
   With ActiveWB
      For i = 1 To UBound(Ary)
         .Sheets(Ary(i, 1)).Move .Sheets(i)
      Next i
   End With
End Sub
Fluff!! You've saved the day yet again! Wow you've bailed me out of so many binds these past few weeks.

I can't thank you enough, and everyone else for your time!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,880
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,102,735
Messages
5,488,557
Members
407,646
Latest member
utl1095

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top