access vba to rearrange excel sheets by name

Hi,

I am searching for a access vba code to move/re-arrange sheets on an excel workbook by sheet names.

Thank you for your help on this
A
Asatoma SadgamayaAnalystAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
How do you want to arrange the sheets?

Alphabetically?
0
Asatoma SadgamayaAnalystAuthor Commented:
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
0
Wayne Taylor (webtubbs)Commented:
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

Open in new window


Sample usage would be...

ReorderSheets "C:\Users\username\Documents\Workbook1.xlsx", Array("Sheet2", "Sheet4", "Sheet3", "Sheet1")
0
The Five Tenets of the Most Secure Backup

Data loss can hit a business in any number of ways. In reality, companies should expect to lose data at some point. The challenge is having a plan to recover from such an event.

Asatoma SadgamayaAnalystAuthor Commented:
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
0
Wayne Taylor (webtubbs)Commented:
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.
0
Gustav BrockCIOCommented:
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

Open in new window

0
Wayne Taylor (webtubbs)Commented:
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")

Open in new window

0
Wayne Taylor (webtubbs)Commented:
Gustav, your code will sort the worksheets alphabetically, but not in a specified order.
0
Gustav BrockCIOCommented:
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.
0
Asatoma SadgamayaAnalystAuthor Commented:
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
0
Wayne Taylor (webtubbs)Commented:
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.
0
Asatoma SadgamayaAnalystAuthor Commented:
Hi Wayne,

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

Thank you
0
Wayne Taylor (webtubbs)Commented:
Ok, but the code I posted still works as you request. Please post the workbooks and code as you are using them.
0
Asatoma SadgamayaAnalystAuthor Commented:
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
0
Asatoma SadgamayaAnalystAuthor Commented:
Please be noted that I need to run this code from an access vba editor
0
Wayne Taylor (webtubbs)Commented:
The code I posted is all you need. Paste it into any regular code module.  Just run the second single line from anywhere else, which passes the file name and sheet order to the first code,  reorders the sheets and saves and closes it.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Gustav BrockCIOCommented:
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

Open in new window

Simply call it like:

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

Open in new window

0
Wayne Taylor (webtubbs)Commented:
Gustav, that's great. My code runs nicely too. The issue isn't the code we're posting, but how it's being run.
0
Asatoma SadgamayaAnalystAuthor Commented:
Great, that worked for me , thank you  so much Wayne, sorry for all the hassle.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.