access vba to rearrange excel sheets by name

How do you want to arrange the sheets?

Alphabetically?

Hi Norie,

Thanks for your interest. Basically I am looking for a Access VBA code in which I can give excel workbook path and sheet names(in an order I need) to arrange them.

Hope you understand my question

Thank you

You could use something like this...

Sub ReorderSheets(filename As String, SheetNames As Variant)

    Dim oXL As Object
    Dim wb As Object
    Dim ws As Object
    Dim index As Integer
    Set oXL = CreateObject("Excel.Application")
    Set wb = oXL.Workbooks.Open(filename)
    For index = UBound(SheetNames) To 0 Step -1
        On Error Resume Next
        wb.Worksheets(SheetNames(index)).Move Before:=wb.Sheets(1)
    Next
    
    wb.Close SaveChanges:=True
    oXL.Quit
    
End Sub

Select allOpen in new window

Sample usage would be...

ReorderSheets "C:\Users\username\Documents\Workbook1.xlsx", Array("Sheet2", "Sheet4", "Sheet3", "Sheet1")

Hi Wayne,

Thanks for your interest. I tried your code, does nothing I am afraid

Sub ReorderSheets(filename As String, SheetNames As Variant)

    Dim oXL As Object
    Dim wb As Object
    Dim ws As Object
    Dim index As Integer
    Set oXL = CreateObject("Excel.Application")
    Set wb = oXL.Workbooks.Open(filename)
    For index = UBound(SheetNames) To 0 Step -1
        On Error Resume Next
        wb.Worksheets(SheetNames(index)).Move Before:=wb.Sheets(1)
    Next
ReorderSheets "C:\Users\philipk1\Desktop\kk\bb b\Small Cell YE Report.xlsx", Array("Shee3", "Sheet2", "Sheet5")
    wb.Close SaveChanges:=True
    oXL.Quit
   
End Sub

How come you are calling the routine from within the routine?

Anyway, the only way it wont work is if the sheets selected aren't in the specified workbook. Comment out  line 10 to see if there are any errors.

This function (tested) will do that:

Public Function SortWorksheets(ByVal Filename As String)

    Dim Application As Excel.Application
    Dim Workbook    As Excel.Workbook
    Dim Worksheet1  As Excel.Worksheet
    Dim Worksheet2  As Excel.Worksheet
    Dim Index       As Integer
    Dim Continue    As Boolean
    
    Set Application = New Excel.Application
    Set Workbook = Application.Workbooks.Open(Filename)
    
    Do
        For Each Worksheet1 In Workbook.Worksheets
            Debug.Print Worksheet1.Index, Worksheet1.Name
            For Each Worksheet2 In Workbook.Worksheets
                Debug.Print , Worksheet2.Index, Worksheet2.Name
                If StrComp(Worksheet2.Name, Worksheet1.Name, vbBinaryCompare) < 0 Then
                    If Worksheet2.Index > Worksheet1.Index Then
                        Worksheet2.Move Worksheet1
                        Continue = True
                        Exit For
                    Else
                        Continue = False
                    End If
                End If
            Next
        Next
    Loop Until Not Continue
    
    Set Worksheet2 = Nothing
    Set Worksheet1 = Nothing
    
    Workbook.Close True
    Set Workbook = Nothing
    Application.Quit
    Set Application = Nothing
    
End Function

Select allOpen in new window

I've tested mine as posted and it worked fine.

I note in your code though you may have mis-spelled a sheet name. Should it be "Sheet3", not "Shee3"?

ReorderSheets "C:\Users\philipk1\Desktop\kk\bb b\Small Cell YE Report.xlsx", Array("Shee3", "Sheet2", "Sheet5")

Select allOpen in new window

Gustav, your code will sort the worksheets alphabetically, but not in a specified order.

True.
The questioneer is not responsive, so I don't know of any other order or how it should be specified. Let's see - or hope so.

Hi Wayne, can you please give an all in one code which works.

Gustav, I did not try your code yet as Wayne mentioned it arranges sheets alphabetical order. I want it to be arranged in what i mention in the script.

Thank you for your patience

Hi Wayne, can you please give an all in one code which works. 

I already have in my original comment. You would call the routine in a seperate routine. Be sure to check the names of the sheets are correct.

Hi Wayne,

Please forget about sheet names, they are not the proper sheet names.

Thank you

Ok, but the code I posted still works as you request. Please post the workbooks and code as you are using them.

Hi Wayne, can i use below script in my procedure, or do you want me run your first code and then this one below.?


ReorderSheets "C:\Users\p1\Desktop\kk\bb b\Sma_Cell.xlsx", Array("Formula", "SmaCel", "Chart")

Thank you

Please be noted that I need to run this code from an access vba editor

This modification runs nicely - using a parameter array:

Public Function SortWorksheets(ByVal Filename As String, ParamArray Names() As Variant)

    Dim Application As Excel.Application
    Dim Workbook    As Excel.Workbook
    Dim Worksheet1  As Excel.Worksheet
    Dim Worksheet2  As Excel.Worksheet
    Dim Item        As Integer
    
    Set Application = New Excel.Application
    Set Workbook = Application.Workbooks.Open(Filename)
    
    For Item = LBound(Names) To UBound(Names)
        Set Worksheet1 = Workbook.Worksheets(Names(Item))
        Set Worksheet2 = Workbook.Worksheets.Item(Item + 1)
        
        Debug.Print Worksheet1.Index, Worksheet1.Name
        If Worksheet1.Index >= Worksheet2.Index Then
            Worksheet1.Move Worksheet2
        End If
    Next
    DoEvents
    
    Set Worksheet2 = Nothing
    Set Worksheet1 = Nothing
    
    Workbook.Close True
    Set Workbook = Nothing
    Application.Quit
    Set Application = Nothing
    
End Function

Select allOpen in new window

Simply call it like:

SortWorksheets "d:\path\file.xlsx", "Formula", "SmaCel", "Chart")

Select allOpen in new window

Gustav, that's great. My code runs nicely too. The issue isn't the code we're posting, but how it's being run.

Great, that worked for me , thank you  so much Wayne, sorry for all the hassle.