VBA Macro To Rearrange 150 Sheets Based on a List in a Column
Results 1 to 7 of 7

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

  1. #1
    Board Regular Jambi46n2's Avatar
    Join Date
    May 2016
    Location
    USA
    Posts
    224
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

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

    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 by Jambi46n2; Aug 13th, 2019 at 06:50 PM.
    Using Microsoft Office 365 ProPlus on Windows 10

  2. #2
    MrExcel MVP mikerickson's Avatar
    Join Date
    Jan 2007
    Location
    Davis CA
    Posts
    22,518
    Post Thanks / Like
    Mentioned
    20 Post(s)
    Tagged
    15 Thread(s)

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

    If you replace Worksheets(i).Name with Worksheets(i).CodeName, it should work the way you want.

  3. #3
    MrExcel MVP mikerickson's Avatar
    Join Date
    Jan 2007
    Location
    Davis CA
    Posts
    22,518
    Post Thanks / Like
    Mentioned
    20 Post(s)
    Tagged
    15 Thread(s)

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

    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-...-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

  4. #4
    Board Regular Jambi46n2's Avatar
    Join Date
    May 2016
    Location
    USA
    Posts
    224
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

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

    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.
    Using Microsoft Office 365 ProPlus on Windows 10

  5. #5
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    26,732
    Post Thanks / Like
    Mentioned
    458 Post(s)
    Tagged
    45 Thread(s)

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

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  6. #6
    Board Regular Jambi46n2's Avatar
    Join Date
    May 2016
    Location
    USA
    Posts
    224
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

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

    Quote Originally Posted by Fluff View Post
    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!
    Using Microsoft Office 365 ProPlus on Windows 10

  7. #7
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    26,732
    Post Thanks / Like
    Mentioned
    458 Post(s)
    Tagged
    45 Thread(s)

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

    You're welcome & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •