Rename sheet with if sheet name already exists while looping workbooks - excel

I am running my code trying to loop through old and new formatted workbooks.
And the sheet names in my old workbooks are different from the new workbooks.
The code is set to run when the new workbook's names are found.
The old workbooks have sheets named "01", "02" and "03".
The new workbooks have sheets named "newname01", "newname02" and "03".
The code is set to run to "newname01" and "newname02".
What I need to do is if the code runs through an old workbook, change the old sheet names to the new workbook's sheet names and run the code. And when running through a new workbook, run through it without changing the sheet names.
I tried changing the old workbook's sheet names to the new ones at the beginning of the code. But when the code is running through an old workbook, its sheets don't contain the new names the code shows an error.
I tried using -
If Not______Is Nothing then.
But I couldn't figure out how that code works.
my code--->
Sub CD3()
Dim wb As Workbook
For Each wb In Application.Workbooks
If Not Application.ActiveProtectedViewWindow Is Nothing Then
Application.ActiveProtectedViewWindow.Edit
End If
Sheets("newname01").Select
Range("A8:B10").Orientation = 90
Range("C10:D10").Orientation = 90
Range("E8:F10").Orientation = 90
Range("G10:H10").Orientation = 90
Range("I8:J10").Orientation = 90
Range("K10:N10").Orientation = 90
Range("O8:Q10").Orientation = 90
Range("Q8:Q10").FormulaR1C1 = "Observation/ Proposals"
'List Sheet Adding
Sheets.Add After:=Sheets("newname02")
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "03"
'more code
ActiveWindow.Zoom = 75
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Range("A11").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Next ws
End Sub
When the code is running through an old workbook, it has sheets named "01" and "02". I need to change their name to "newname01" and "newname02" and then run the code.
this is a code I found it changed the code regardles of the name
Sub RenameSheet()
Dim Sht As Worksheet
Dim NewSht As Worksheet
Dim newShtName As String
Set NewSht = ActiveSheet
newShtName = "newname01"
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = "newname02" Then
newShtName = "newname01" & "_" &
ThisWorkbook.Sheets.Count
End If
Next Sht
NewSht.Name = newShtName
End Sub
I only need to Change sheet name "01" to "newname01" and "02" to "newname02". And when it already named "newname01" run the rest of the code.

?I tride using -
If Not______Is Nothing then.
I have a feeling that you are not using proper error handling and hence that line or the one before that where you are setting the worksheet is erroring out. Try something like this (UNTESTED)
Option Explicit
Sub Sample()
Dim wbOld As Workbook
Dim wbNew As Workbook
Dim wsOld As Worksheet
Dim wsNew As Worksheet
Dim wsName As String
'~~> Change these two as applicable
Set wbOld = Workbooks("OldWorkBook")
Set wbNew = Workbooks("NewWorkBook")
'~~> Loop through the worksheets in the old workbook
For Each wsOld In wbOld.Worksheets
'~~> Create the name as per new worksheet
'newname01
wsName = "newname" & wsOld.Name
'~~> Attempt to set it. If the worksheet doesn't
'~~> exists, you will not get an error
On Error Resume Next
Set wsNew = wbNew.Sheets(wsName)
On Error GoTo 0
'~~> Check if the object is not nothing
If Not wsNew Is Nothing Then
'~~> Worksheet exists
'
'~~> Do what you want
'
'~~> This is important to prevent false positives
Set wsNew = Nothing
End If
Next wsOld
End Sub

I Wrote two Codes for the two sheet names. The run the code Below
Sub If_Run()
If Not Application.ActiveProtectedViewWindow Is Nothing Then
Application.ActiveProtectedViewWindow.Edit
End If
'Run_for_newname01() = for workbooks containing a Sheet with "newname01"
'Run_for_01() = for workbooks containing a Sheet with "01"
ws = ActiveWorkbook.Worksheets.Count
For i = 1 To ws
With ActiveWorkbook.Worksheets(i)
If .Name Like "*newname01*" Then
Run_for_newname01
ElseIf .Name Like "*01*" Then
Run_for_01
End If
End With
Next i
End Sub

Related

Copy tabs of similar partial name to another workbook

Would appreciate if there's any help anywhere. Let's say, I have the following tabs: Data Set 001, Data Set 002, Data Set 003, so long the tab names contain Data Set, it should copy over to another workbook (let's say Main File). Any help with regards to this is welcomed. Thanks all in advance!
Best Regards,
Josh
I used this in Workbook containing worksheet, "ASSESSMENT FORMxx":
Sub CopyWorksheetsToNewWorkbook()
'This macro is to be in the ActiveWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Add
wb.SaveAs Filename:="Book10" & ".xlsx"
Workbooks.Open ("Book10.xlsx")
For Each ws In Workbooks("ActiveWorkbookName.xlsm").Sheets
If ws.Name Like ("ASSESSMENT FORM*") Then ws.Copy Before:=Workbooks("Book10.xlsx").Worksheets("Sheet1")
Next ws
Workbooks("Book10.xlsx").Worksheets("Sheet1").Move Before:=Workbooks("Book10.xlsx").Sheets(1)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Note that both workbook with worksheet "ASSESSMENT FORMxx" and Book10.xlsx must be open.
Did you have a go at any code?
Sub Whatever()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("AnyOpenWorkbookName.xlsx")
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "Data Set" & "*" Then
Call ws.Copy(after:=wb.Sheets(wb.Sheets.Count))
End If
Next ws
End Sub
You need to loop through all Worksheets of your 1st Workbook, test if its name contains Data set with Worksheet.Name and InStr.
If the InStr function returns something else than 0 (meaning your Worksheet name contains Data Set), you can copy the current Worksheet to the 2nd Workbook.
Adapt this sample to your needs:
'Loop through all worksheets
If InStr(wsCurrent.Name,"Data Set") <> 0 Then
' Copy wsCurrent to new WorkBook
End If
' End of loop

VBProject.VBComponents(wsTarget.CodeName).Name = code fail EVERY OTHER time. Why?

I have a small app containing about 20 subs which runs perfectly... Every other time.
It fails, in the sub ImportData, the first time I add a code name to a newly created sheet. on the following line:
ThisWorkbook.VBProject.VBComponents(wsTarget.CodeName).Name = "Customers"
The code below contains three subs which which can recreate the issue. Important note: I can run the sub ImportData as many times in a row without any issues but if I call the sub "Sync()" twice in a row it will fail on the second attempt but works fine on the third attempt and so on (Maybe it doesn't like odd numbers..)
Any ideas as to why this is happening would be greatly appreciated.
FYT: I am running this code in Excel for Mac
Public LastRow As Long
Private wks As Worksheet
Sub Sync()
Call ImportData
Call SyncBoth
End Sub
Public Sub ImportData()
'++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++ 1. ImportData will allow user to select file to import data from
'+++++ 2. Copy both the Customers and Vendors data to their respective sheets
'++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim LastRow As Long
Dim MaxDate As Date
Dim ShCount As Integer
Dim SourceFile As String
SourceFile = "/Users/phild/Documents/RTPro/Customer and Vendor Raw Sync.xlsm"
Dim SourceWb As Workbook
Set SourceWb = Workbooks.Open(SourceFile)
Dim TargetWb As Workbook
Set TargetWb = ThisWorkbook
Dim sheet As Worksheet
For ShCount = 1 To 2
Select Case ShCount
Case 1
Set wsSource = SourceWb.Worksheets("Sheet1") 'Set Worksheet to copy data from
ThisWorkbook.Sheets("Customers").Delete 'Delete old Customer worksheet in this worksheet
Set sheet = ThisWorkbook.Sheets.Add 'Create New Customer woeksheet in this woekbook
sheet.Name = "Customers" 'Name new Customer worksheet
Set wsTarget = ThisWorkbook.Worksheets("Customers") 'Set Customers ws as the target ws
Debug.Assert ThisWorkbook.VBProject.Name <> vbNullString '<--Force the VBE to exist. Don't pollute the Immediate window
ThisWorkbook.VBProject.VBComponents(wsTarget.CodeName).Name = "Customers" 'Give Customers a Code name
'THE LINE OF CODE ABOVE RESULTS IN A Runtime error '32813"
' Method 'Name' of object '+VBComponent' failed
' EVERY OTHER TIME I RUN THE SUB Sync()
Case 2
Set wsSource = SourceWb.Worksheets("Sheet3") 'Set Worksheet to copy data from
ThisWorkbook.Sheets("Vendors").Delete 'Delete old Vendors worksheet in this worksheet
Set sheet = ThisWorkbook.Sheets.Add 'Create New Vendor worksheet in this woekbook
sheet.Name = "Vendors" 'Name new Vendor worksheet
Set wsTarget = ThisWorkbook.Worksheets("Vendors") 'Set Customers ws as the target ws
Debug.Assert ThisWorkbook.VBProject.Name <> vbNullString '<--Force the VBE to exist. Don't pollute the Immediate window '
ThisWorkbook.VBProject.VBComponents(wsTarget.CodeName).Name = "Vendors" 'Give Vendors a Code name
End Select
Call CleanTarget(wsTarget)
LastRow = Find_LastRow(wsSource)
wsSource.Range("A1:Z" & LastRow).Copy Destination:=wsTarget.Range("A1")
Next ShCount
SourceWb.Close
End Sub
Sub SyncBoth()
Dim ShCount As Integer
For ShCount = 1 To 2
Select Case ShCount
Case 1
Set wks = Customers 'Work in sheet("Customers")
LastRow = Find_LastRow(wks) 'Last row of "Customers"
Case 2
Set wks = Vendors 'Work in sheet("Vendors")
LastRow = Find_LastRow(wks) 'Last row of "Vendors"
End Select
Debug.Print wks.Name
Next ShCount
'Normally I have about 10 subs here that are called sequentially. But this is enough the cause the errorw
End Sub```
You're modifying the host VBA project at run-time - the code name identifier for Sheet1 is a compile-time, project-global scope object: even if it's not used anywhere, there's a legitimate chance that changing it requires recompiling the project.
So the code runs fine, up until it shoots its own foot off by renaming a global object; the next run now runs fine because now the compiled code matches the actual VBComponent in the project.
Consider having the macro in a separate VBA project, that prompts for which macro-enabled workbook to rename components in: because that VBA project won't be the VBA code that's compiled & running, it should "just work" then.

Sheets selected in listbox2 and exporting them to a new workbook

Hopefully somebody can help me.
I have 2 Listboxes in a userform (Listbox1 & Listbox2), in Listbox1 I get the names of all the visible sheets in the workbook.
In Listbox2 will be the sheets I select in Listbox1, to copy to a new workbook.
The filling of Listbox1 works, the copying of the sheetnames to Listbox2 workt too.
I select the sheetnames in Listbox2, and then use the following code to copy the sheets to a new workbook.
For K = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(K) Then
Worksheets(ListBox2.List(K, 0)).Copy
End If
Next K
But I get a runtime error-9 "Subscript out of range error"
Question:
What goes wrong here ?
How do I change the code so that all selected items/sheets in Listbox2 are nicely exported to a new workbook.
Thanks for all the help
Worksheets(ListBox2.List(K, 0)).Copy
Doing too many things at once, making too many assumptions: it's assuming that ActiveWorkbook has a worksheet that's named after ListBox2.List(K, 0). It's also assuming that ListBox2.List(K, 0) will succeed.
Break it down.
Dim sheetName As String
sheetName = ListBox2.List(K, 0)
If this succeeds, we can proceed to get the worksheet:
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets(sheetName)
If this succeeds, we can proceed to copy the sheet:
ws.Copy
But we're in a loop... and ws.Copy is going to change the ActiveWorkbook - so if the first iteration worked, the second is guaranteed to blow up.
The first thing to do is therefore to capture the "source" workbook before we even begin:
Dim srcBook As Workbook
Set srcBook = ActiveWorkbook
And then to use that object reference to qualify the Worksheets call:
...
Set ws = srcBook.Worksheets(sheetName)
...
Now, the next problem is, every selected sheet will be copied to a new workbook - meaning, every selected sheet gets its own new workbook.
If that's intended, all is good. But that's not how I read "copy the sheets to a new workbook" - right?
In order for all copies to end up in the same destination workbook, you need to keep a reference to that workbook. And since it's going to be created and activated on the fly by the first copy you make, I'd do something like this:
Dim dstBook As Workbook
...
If dstBook Is Nothing Then
'destination workbook doesn't exist yet
ws.Copy
Set dstBook = ActiveWorkbook
Else
'copy worksheet to destination workbook, after the last sheet
With dstBook
ws.Copy After:=.Worksheets(.Worksheets.Count)
End With
End If
...
So:
Dim srcBook As Workbook
Set srcBook = ActiveWorkbook ' ThisWorkbook?
Dim dstBook As Workbook
For K = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(K) Then
Dim sheetName As String
sheetName = ListBox2.List(K, 0)
Dim ws As Worksheet
Set ws = srcBook.Worksheets(sheetName)
If dstBook Is Nothing Then
'destination workbook doesn't exist yet
ws.Copy ' creates & activates a new workbook
Set dstBook = ActiveWorkbook 'there's our destination
Else
'copy worksheet to destination workbook, after the last sheet
With dstBook
ws.Copy After:=.Worksheets(.Worksheets.Count)
End With
End If
End If
Next

Copy worksheet between workbooks and overwrite the current worksheet

I have written VBA code that opens up a destination workbook, copies one of the worksheets, and pastes it into the current workbook.
When I run it a second or third time etc... instead of overwriting the current worksheet, it creates a completely new one.
Ex: Worksheet is called "data", first time it transfers "data", second time "data(2)".
I have another worksheet that uses VLOOKUP function to look at some cells of this data worksheet, so it is crucial that it has correct name "data".
I thought about deleting the current (data) file before running the macro, but what if something crashes and I lose my worksheet? Is there a better solution?
NOTE: I am running the macro from the main workbook to get the sheet to be copied from the external workbook.
Sub UpdateT()
Dim wb As Workbook
Dim aw As Workbook
'Open 2nd Workbook
Set aw = Application.ActiveWorkbook
Set wb = Workbooks.Open(Filename:="C:\Users\yilmadu00\Desktop\T.xlsx")
'Copy To Different Workbook
wb.Sheets("data").Copy After:=aw.Sheets("Data1")
'Close 2nd Workbook
aw.Save
wb.Close
aw.Sheets("data").Visible = False
ActiveWorkbook.Protect ("Password")
End Sub
Function to check whether worksheet exists (credits to #ScottCrainer):
Function SheetExists(ws As String)
SheetExists = Not IsError(Application.Evaluate(ws & "!A1"))
End Function
NOTE:
It does have the issue: if A1 on the sheet contains an error it will return a false negative.
ActiveWorkbook vs ThisWorkbook, Sheets vs Worksheets
You have used 'Activeworkbook' and 'Sheet(s)' in the code so I played along.
But
Although you can have a third workbook to run the code from, I'm guessing you are running the code from a module in the 'ActiveWorkbook'. If this is true, it would be more correct to use 'ThisWorkbook' instead which always refers to the workbook that contains the code (module), to avoid accidentally running the code on a third workbook.
Sheet(s) refers to Worksheet(s) and Chartsheet(s), again I'm guessing there are no chartsheets involved in this code, therefore it would be more correct to use 'Worksheet(s)' instead of 'Sheet(s)'.
Sub UpdateT()
Const cStrPath As String = "C:\Users\yilmadu00\Desktop\T.xlsx"
Const cStrAfter As String = "Data1"
Const cStrName As String = "data"
Const cStrOld As String = "data_old"
Dim aw As Workbook '1st workbook, 'ActiveWorkbook'
Dim wb As Workbook '2nd workbook
Dim oWs As Sheet 'Each sheet in workbook 'aw'
Dim blnFound As Boolean 'True if sheet(cStrName) was found
Set aw = ActiveWorkbook 'Create a reference to the ActiveWorkbook
Set wb = Workbooks.Open(Filename:=cStrPath) 'Open 2nd Workbook
With aw
' .UnProtect ("Password")
'Check each sheet in workbook 'aw'.
For Each oWs In aw.Sheets
With oWs
'Check if there already is a sheet with the name 'cStrName'.
If .Name = cStrName Then
.Name = cStrOld 'Rename the sheet.
blnFound = True 'Sheet(cStrName) was found.
Exit For 'Immediately stop checking, there can only be one.
End If
End With
Next
End With
With wb
'Copy sheet from 2nd workbook ('wb') to workbook 'wa'.
.Sheets(cStrName).Copy After:=aw.Sheets(cStrAfter)
.Close 'Close 2nd workbook ('wb').
End With
With aw
With Application
If blnFound = True Then 'Sheet(cStrName) was found.
.DisplayAlerts = False 'Disable showing delete message.
aw.Sheets(cStrOld).Delete 'Delete old version of sheet.
.DisplayAlerts = True
End If
End With
.Sheets(cStrName).Visible = False 'Hide sheet named 'cStrName'
.Protect ("Password")
.Save 'Save workbook 'aw'.
End With
End Sub
The next time you want to do something with the sheet you have to unprotect it or the code will fail. Hidden sheets can be deleted with no problems.

Active sheet name change in sequence

I've got a workbook with two spreadsheets named "WT-1" and "CL-1" (it could be more of them with diff. names).
When i.e. "WT-1" is active, I would like to be able to (by using a button with macro assigned to it) copy this current (active) spreadsheet and rename it in sequence like WT-2, WT-3, WT-4 etc .
I guess change needs to apply only to spreadsheets who's name contains "WT-" as the name change should be addressed to the new sheet only. All other existing worksheets should not be touched. here it is - Pls help :) It changes name of one new spreadsheet. If there is more than just 1 worksheet in my workbook, it doesn't work.
Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left(Trim(ws.Name), 3) = "WT-" Then
ws.Name = shtName(i)
i = i + 1
End If
Next ws
End Sub
Macro is suppose just to change the name of a new and freshly copied spreadsheet. So if I copy WT-2 and create new sheet named WT-2(2) and run macro - it will work and change new sheet name to WT-1 (being first name in the range on 'wslist') . That seems to be OK. But, if I have any other spreadsheet in my workbook (except active sheet and already copied new sheet) it doesn't work and gives me an error 1004 - "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"
When I click on de-bag, this I found highlighted: ws.Name = shtName(i)
The issue is if you have the situation with following sheets
WT-1
WT-1 (2)
WT-2
Your code tries to rename WT-1 (2) into WT-2 but that already exists.
So a possibility was you would need to rename these to something else first like
WT-1
#WT-2
#WT-3
and then remove the # in another loop.
This way you prevent renaming into a name that already exists.
Option Explicit
Public Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 3) = "WT-" Then
'test if we run out of sheet names
If i > UBound(shtName) Then
MsgBox "Running out of sheet names … aborting"
Exit Sub
End If
ws.Name = "#" & shtName(i) 'add a # to all new sheet names
i = i + 1
End If
Next ws
'remove the # from the sheet nam
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 1) = "#" Then
ws.Name = Right$(ws.Name, Len(ws.Name) - 1)
End If
Next ws
End Sub
As QHarr pointed out it's probably a good idea to test if you are running out of sheet names.

Resources