Slight alteration to VBA code for renaming sheets

steallan

Active Member
Joined
Oct 20, 2004
Messages
308
Hi - hoping someone better than me can help with a slight adjustment to the below code. I think its easy for someone with the skills.

So it currently opens all the files in a picked folder and renames the sheet to Sheet1, so long as there's only one sheet.

Problem is I have a combination of XLSX files and XLS files. Yes, xls files, its embarassing I know.

I'm not sure if the code will open the xls files. Can it be altered to do so if it doesnt already?

Even better, could the code be changed to, after opening the xls file and renaming the sheet, then saving the file as XLSX?

and finally, the code is more complex than I need it to be. I dont need it to open a file picker it can just run on the following folder:

\\uug.vcm.cc\Domestic_Retail\CollectionsAnalyticsTeam\DCA\Invoices\Input

sorry, I know i've asked a lot, but my VBA skills are.......well they're not really skills. Skills is too grand a term.

I'm actually using an Event in Alteryx to run vb code to open an excel and run this VBA code, then close the excel, then run my workflow! So at least I can do somethings.

Any help would be greatly appreciated.

Code:

Sub Rename()

Dim CurrentBook As Workbook
Dim ImportFiles As FileDialog
Dim FileCount As Long
Dim wbName As String

'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
.AllowMultiSelect = True
.Title = "Pick Files to Adjust"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With

Application.DisplayAlerts = False
Application.DisplayAlerts = False

'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
wbName = Replace(CurrentBook.Name, ".xlsx", "")
CurrentBook.Activate
ActiveSheet.Name = "Sheet1"
CurrentBook.Close True
Next FileCount

Application.DisplayAlerts = True
Application.DisplayAlerts = True

End Sub
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Hello. First things first is to convert all xls files to xlsx.

This code does that. Please read the caution in the code and test on a COPY of your data as this code deletes files without sending to recycle bin

Code:
Sub xls_To_xlsx()


Const sPath As String = "\\uug.vcm.cc\Domestic_Retail\CollectionsAnalyticsTeam\DCA\Invoices\Input\"


Dim sFileName As String, sFullPath As String
Dim wb As Workbook


    On Error GoTo errHandle
    sFileName = Dir(sPath & "*.xls")
    
    Do Until sFileName = ""
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        On Error Resume Next
        
        'open workbook
        Set wb = Workbooks.Open(sPath & sFileName)
        If wb Is Nothing Then
            ' nothing so failed
            MsgBox "Couldn't open " & sFileName
            Exit Sub
        End If
        
        'if we get here we have the xls file
        On Error GoTo errHandle
        'get the full string path of file without extension
        sFullPath = sPath & Replace(wb.Name, ".xls", "")
        'Save the file
        wb.SaveAs sFullPath, xlOpenXMLWorkbook
        
        '****CAUTION***
        'This line will delete without being able to undelete. Will NOT be in recycle bin
        'If unsure just remove this line and delete files manually
        Kill sPath & sFileName
        'close
        wb.Close
        'destroy variable
        Set wb = Nothing
        'get next file
        sFileName = Dir
    Loop
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


'handle errors
errHandle:
    MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
And this code will rename the only sheet of any file with just one sheet to Sheet1. Again, ensure to test on a copy of your data as it changes the file and saves

Code:
Sub ChangeSheetName()

Const sPath As String = "H:\Test\" '"\\uug.vcm.cc\Domestic_Retail\CollectionsAnalyticsTeam\DCA\Invoices\Input\"


Dim sFileName As String, sFullPath As String
Dim wb As Workbook


On Error GoTo errHandle
    'only get xlsx files
    sFileName = Dir(sPath & "*.xlsx")
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Do Until sFileName = ""


        On Error Resume Next
        
        'open workbook
        Set wb = Workbooks.Open(sPath & sFileName)
        If wb Is Nothing Then
            ' nothing so failed
            MsgBox "Couldn't open " & sFileName
            Exit Sub
        End If
        
        'if we get here we have the xls file
        On Error GoTo errHandle
        
        If wb.Worksheets.Count = 1 Then
            'change the name if only 1 sheet exists
            wb.Worksheets(1).Name = "Sheet1"
            wb.Save
        End If
        
        'close
        wb.Close
        'destroy variable
        Set wb = Nothing
        'get next file
        sFileName = Dir
    Loop
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


'handle errors
errHandle:
    MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:
Upvote 0
thanks for the help gallen, you're a star.

Im just trying to run the first code, to change the xls files to xlsm. It ran fine, but i'm left with files with no file extension. xls are gone, and there's new files in their place, but no extension.


I love the way it anniliates the xls files afterwards. best thing for them
 
Last edited:
Upvote 0
ah ha!

Showing peon vba skills i changed:

sFullPath = sPath & Replace(wb.Name, ".xls", "")

to:

sFullPath = sPath & Replace(wb.Name, ".xls", ".xlsx")

and it seems to work like a charm.

thanks again gallen, really appreciate the code help.
 
Upvote 0
thanks for the help gallen, you're a star.

Im just trying to run the first code, to change the xls files to xlsm. It ran fine, but i'm left with files with no file extension. xls are gone, and there's new files in their place, but no extension.


I love the way it anniliates the xls files afterwards. best thing for them

This shouldn't have happened. This line automatically saves it with .xlsx:

Code:
[COLOR=#333333]wb.SaveAs sFullPath, xlOpenXMLWorkbook[/COLOR]

the xlOpenXMLWorkbook argument tells the line to save it as an xlsx file
 
Upvote 0
i'll take the change out and try it again, tomorrow I think, got to go babysit a meeting now....

Thanks to you i'll be able to get it done. If not i'll be back. Cheers
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top