Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

MS Access VBA to change Worksheet Tab name

Posted on 2013-05-29
10
Medium Priority
?
3,477 Views
Last Modified: 2013-05-30
Hello Experts,

I have a MS Excel workbook with 5 worksheets and I need to change the Worksheet Tab Names using MS Access VBA.  Below displays the 5 worksheets and my VBA attempt.  This code displays "Object Required" at the statement,  "wSheet.Name = rs!SSTabOut".  Inside MS Access is a table (TblReportsOrder) with the correct Tab Names.

Can you please supply the correct syntax as I was opening the workbook and reading in the MS Access Table?  I feel I need to link the two...

ID      SSName                                                            SSTab                  SSTabOut
1      S:\2013 reports\cfhc ab other 0313.xlsm      Output 1 (313)      CASCI
2      S:\2013 reports\cfhc ab other 0313.xlsm      Output 1 (312)      NCIA
3      S:\2013 reports\cabc nr other 0313.xlsm      Output 1 (320)      NCAS
4      S:\2013 reports\abhc nr other 0313.xlsmOutput 1 (102)      Willse
5      S:\2013 reports\BC Pre_Ab.xlsm      Output 1 (121)      First

VBA:
Private Sub Test222_Click()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim varCentreFooter As String
Dim rs As Recordset
Dim SSTab As String
Dim SSTabOut As String
Dim shtName As String
Dim ws As Worksheet
Set xlApp = CreateObject("Excel.Application")

Set rs = CurrentDb.OpenRecordset("TblReportsOrder")
rs.MoveFirst

xlApp.DisplayAlerts = False
'Set reference to Workbook object
xlApp.EnableEvents = False
Set xlBook = xlApp.Workbooks.Open("H:\PDF\Master.xls")   'Open the workbook

   For Each ws In xlBook.Worksheets
      shtName = rs!SSTab
      shtTabName = rs!SSTabOut
      wSheet.Name = rs!SSTabOut
   Next ws


    xlBook.Save
    xlBook.Close
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
   
MsgBox "Worksheet Tab Names have been Updated!"

End Sub
0
Comment
Question by:CFMI
  • 3
  • 3
  • 3
  • +1
10 Comments
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 39205801
what are the names of the Sheets in the file  "Master.xls"?

which Sheet you want to change the name and what name are you going to use based from the recordset you opened?

i.e..  "Sheet1"  will be "CASCI" or "NCIA" or whatever???
0
 
LVL 1

Author Comment

by:CFMI
ID: 39205841
The sheet names in the workbook are identical to the names listed in the MS Access table (TblReportsOrder) using the field named, "SSTab" and the field to rename it to is "SSTabOut".  For example, Sheet 1 is, "Output 1 (313)" and I want to rename it to "CASCI".
0
 
LVL 16

Expert Comment

by:Calvin Brine
ID: 39205855
Not sure what you are trying to do here?  I figure it's just your testing.

   For Each ws In xlBook.Worksheets
      shtName = rs!SSTab
      shtTabName = rs!SSTabOut
      wSheet.Name = rs!SSTabOut
   Next ws

change it to this.
   For Each ws In xlBook.Worksheets
      ws.name = rs!SSTabOut
   Next ws

Open in new window

HTH
Cal
0
Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

 
LVL 35

Expert Comment

by:Norie
ID: 39205857
Perhaps this.
Do Until rs.EOF
    xlBook.Worksheets(rs!SSTab).Name= rs!SSTabOut
    rs.MoveNext
Loop

Open in new window

0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 39205878
try this code, copy and paste


Private Sub Test222_Click()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim varCentreFooter As String
Dim rs As Recordset
Dim SSTab As String
Dim SSTabOut As String
Dim shtName As String
Dim ws As Worksheet


Set rs = CurrentDb.OpenRecordset("TblReportsOrder")
rs.MoveFirst


Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
'Set reference to Workbook object
xlApp.EnableEvents = False
    xlApp.Workbooks.Open("H:\PDF\Master.xls")   'Open the workbook
      
Do until rs.eof
    with xlApp
         .Worksheets(rs!SSTab).Select
         .Worksheets(rs!SSTab).Name= rs!SSTabOut
    end with
   rs.movenext
Loop
    xlApp.Activeworkbook.save
      xlApp.quit
    set xlApp = Nothing
   
MsgBox "Worksheet Tab Names have been Updated!"

End Sub
0
 
LVL 35

Expert Comment

by:Norie
ID: 39205942
The code I posted would go right after this.
Set xlBook = xlApp.Workbooks.Open("H:\PDF\Master.xls")  

Open in new window


You would also remove this.
   For Each ws In xlBook.Worksheets
      shtName = rs!SSTab
      shtTabName = rs!SSTabOut
      wSheet.Name = rs!SSTabOut
   Next ws

Open in new window

0
 
LVL 1

Author Comment

by:CFMI
ID: 39207332
Good Morning,

At first, I received Type Mismatch then I updated the code and now I am receiving, "Subscript out of Range" and debugging points to ".Worksheets(shtNameTab).Select".  Below displays the current code:

Private Sub Test222_Click()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim varCentreFooter As String
Dim rs As Recordset
Dim SSTab As String
Dim SSTabOut As String
Dim shtName As String
Dim shtNameTab As String
Dim ws As Worksheet


Set rs = CurrentDb.OpenRecordset("TblReportsOrder")
rs.MoveFirst


Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
'Set reference to Workbook object
xlApp.EnableEvents = False
    xlApp.Workbooks.Open ("H:\PDF\Master.xls")  'Open the workbook
   
Set xlBook = xlApp.Workbooks.Open("H:\PDF\Master.xls")
     
Do Until rs.EOF
    With xlApp
        shtNameTab = rs!SSTab
         .Worksheets(shtNameTab).Select
         .Worksheets(shtNameTab).Name = rs!SSTabOut
    End With
   rs.MoveNext
Loop
    xlApp.ActiveWorkbook.Save
      xlApp.Quit
    Set xlApp = Nothing
   
MsgBox "Worksheet Tab Names have been Updated!"


End Sub
0
 
LVL 35

Expert Comment

by:Norie
ID: 39207347
You don't need that line of code.

Do you definitely have worksheets with the names in SSTab in the workbook you are opening?

Are there any other workbooks open?

Did you try the code I posted?

Here's the original code with it added.
Private Sub Test222_Click()
Dim xlApp As Object
Dim xlSheet As Object
Dim rs As Recordset
Dim ws As Worksheet

    Set xlApp = CreateObject("Excel.Application")

    Set rs = CurrentDb.OpenRecordset("TblReportsOrder")
    rs.MoveFirst

    xlApp.DisplayAlerts = False
    xlApp.EnableEvents = False
    
    Set xlBook = xlApp.Workbooks.Open("H:\PDF\Master.xls")   'Open the workbook

    Do Until rs.EOF
        xlBook.Worksheets(rs!SSTab).Name = rs!SSTabOut
        rs.MoveNext
    Loop

    xlBook.Close True
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

    MsgBox "Worksheet Tab Names have been Updated!"

End Sub

Open in new window

0
 
LVL 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 2000 total points
ID: 39207564
you don't need this line in my codes

Set xlBook = xlApp.Workbooks.Open("H:\PDF\Master.xls")  


your error  of
"Subscript out of Range" and debugging points to ".Worksheets(shtNameTab).Select"

means, the "shtNameTab" does not exists in the workbook



use this revised codes


Private Sub Test222_Click()
Dim xlApp As Object
Dim varCentreFooter As String
Dim rs As Recordset

Dim j as integer

Set rs = CurrentDb.OpenRecordset("TblReportsOrder")
rs.MoveFirst


Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
'Set reference to Workbook object

    xlApp.Workbooks.Open ("H:\PDF\Master.xls")  'Open the workbook
        
Do Until rs.EOF
    With xlApp
		For j =1 to .Worksheets.Count
		  if .Worksheets(j).name=  rs!SSTab then
         
                          .Worksheets(j).Name = rs!SSTabOut
			 exit for
		  end if
	   next 
    End With
   rs.MoveNext
Loop
    xlApp.ActiveWorkbook.Save
      xlApp.Quit
    Set xlApp = Nothing
   
MsgBox "Worksheet Tab Names have been Updated!"


End Sub 

Open in new window

0
 
LVL 1

Author Closing Comment

by:CFMI
ID: 39207754
Excellent the revised codes works well and all of the worksheet names have been changed - Thank you!
0

Featured Post

Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need a simple but flexible process for maintaining an audit trail of who created, edited, or deleted data from a table, or multiple tables, and you can do all of your work from within a form, this simple Audit Log will work for you.
Microsoft Access has a limit of 255 columns in a single table; SQL Server allows tables with over 255 columns, but reading that data is not necessarily simple.  The final solution for this task involved creating a custom text parser and then reading…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

971 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question