i have this code , normally it saves a sheet with the possibility of giving it a new name , i tried to change it to save just some columns and not the hole sheet but the code showes me eror 1004 , can any one help me with this please thank you
this is my code :
Sub save()
Worksheets("operations").Activate
Dim sName As String
Sheets("operations").Range("N1:Q6000").Copy Destination:=Sheets(Sheets.Count)
On Error Resume Next
Do
sName = InputBox("Enter name for the release")
If sName = "" Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Exit Sub
End If
ActiveSheet.Name = sName
If ActiveSheet.Name = sName Then Exit Do
Beep
Loop
End Sub
Is this what you are trying?
Sub save()
Dim sName As String
Dim ws As Worksheet
sName = InputBox("Enter name for the release")
If Not sName = "" Then
On Error Resume Next
Set ws = Sheets(sName)
On Error GoTo 0
If ws Is Nothing Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets("operations").Range("N1:Q6000").Copy Destination:=Sheets(Sheets.Count).Range("A1")
ActiveSheet.Name = sName
Else
Beep
End If
End If
End Sub
Couple of things...
Ask for the name first.
Do not use a Do Loop
Check if the name given by the user doesn't match with the existing sheet
When specifying a destination, specify the range as well. I have used A1 as an example.
Related
I have the following code that copies a Master worksheet and renames it using Application.Inputbox.
'Generates input box to name the new Sheet and checks duplicate names
Set wks = ActiveSheet
Do While sName <> wks.Name
sName = Application.InputBox _
(Prompt:="Enter New Year")
On Error Resume Next
wks.Name = sName
On Error GoTo 0
Loop
Set wks = Nothing
This works fine except when the user clicks cancel.
Current out comes are;
User inputs something and clicks 'ok' = master sheet copied and renamed to input value.
User inputs nothing and clicks 'ok' = Input box loops until value entered and 'ok' clicked or cancel clicked.
User clicks 'cancel' = master sheet copied and renamed to 'False'.
Desired Out come for user clicks 'cancel' = sub exited and nothing copied or altered.
Any help?
I would change your code in the following way.
Dim sname As Variant
Dim wks As Worksheet
Set wks = ActiveSheet
Do While sname <> wks.Name
sname = Application.InputBox _
(Prompt:="Enter New Year")
If sname = vbFalse Then
MsgBox "You pressed Cancel"
Else
On Error Resume Next
wks.Name = sname
On Error GoTo 0
End If
Loop
Set wks = Nothing
In case user presses Cancel sname becomes a boolean with value False
You can detect a cancel by looking for an vbNullString (empty) string
Set wks = ActiveSheet
Do While sName <> wks.Name
sName = Application.InputBox _
(Prompt:="Enter New Year")
If sName = vbNullString Then
MsgBox ("Cancel button clicked!")
Exit Sub
End If
On Error Resume Next
wks.Name = sName
On Error GoTo 0
Loop
Set wks = Nothing
Using above help added this to my code;
'Generates input box to name the new Sheet and checks duplicate names
Set wks = ActiveSheet
Do While sname <> wks.Name
sname = Application.InputBox _
(Prompt:="Enter New Year")
If sname = vbFalse Then
MsgBox "You pressed Cancel"
Application.DisplayAlerts = False
Sheets("MASTER (2)").Delete
Application.DisplayAlerts = True
Sheets("MASTER").Visible = False
Exit Sub
Else
On Error Resume Next
wks.Name = sname
On Error GoTo 0
End If
Loop
Set wks = Nothing
The help above allowed the code to accept a valid input, detect a duplicate input, check for no input and loop as needed, and if the 'cancel' button was clicked then it informed the user. I added further code to exit the sub after deleting the unwanted worksheet (copied from a master sheet earlier in the code).
Thank you all for your help.
I tried to create VBA macro in excel where one excel sheet tracks a path and creates a new tab in another sheet. It works well but when I create another tab "accidentally" with same name it gives me error as "Name already taken try another one". I don't want to create one more tab with same name. Instead it should stop me from creating tabs with same name
Is there anyway if there that name already exist it gives me a pop up saying name already exist I get only one option as ok to click. I click Ok and the additional sheet that is created doesn't get saved (or if already created deletes itself or save as same name with (2) next to it as excel usually do for repeated sheets). I am trying something like this
If wb.ActiveSheet.Name = sName Then wb.ActiveSheet.Delete
Here is my code
Private Sub Filling_List()
Dim sPath As String
Dim sFile As String
Dim wb As Workbook
Dim sName As String 'add sName declaration
Dim wb1 As Workbook
Dim ws1 As Worksheet
Set wb1 = ThisWorkbook
Set ws1 = ThisWorkbook.Worksheets("S0")
Application.ScreenUpdating = False
sPath = "C:\Users\arp\Desktop\Filling list macro\"
sFile = sPath & "ArF Filling List.xlsm"
Set wb = Workbooks.Open(sFile)
wb.Worksheets("ArF Templete").Copy After:=Worksheets(Worksheets.Count)
sName = ws1.Range("A1") & " " & ws1.Range("T2")
wb.ActiveSheet.Name = sName
'If wb.ActiveSheet.Name = sName Then wb.ActiveSheet.Delete "I am trying this but it doesn't work"
If sName = vbNullString Then Exit Sub 'compare against vbNullstring not empty string literal
With wb.Worksheets(sName)
.Cells(3, "E") = InputBox("Your Initials:")
'.Cells(5, "E") = InputBox("Col?:")
.Cells(6, "E") = InputBox("I:")
.Cells(7, "E") = InputBox("ET1 B:")
.Range("B03") = wb1.Worksheets("Que").Range("B02").Value2
.Range("B04") = wb1.Worksheets("Que").Range("E01").Value2
.Range("B05") = wb1.Worksheets("Que").Range("B01").Value2
.Cells(3, "E") = wb1.Worksheets("Que").Range("E02").Value2
.Cells(5, "E") = "Yes"
'Filling order
.Range("B38:B43") = wb1.Worksheets("Que & Tsc Cal").Range("B04:B09").Value2
.Range("C38:C43") = wb1.Worksheets("Que & Tsc Cal").Range("C04:C09").Value2
.Range("D38:D43") = wb1.Worksheets("Que & Tsc Cal").Range("A04:A09").Value2
'Retains
End With
Application.ScreenUpdating = True
End Sub
I developed above version with the help of you guys here and joining bits and pieces from other threads.Any suggestions to make it better are very welcome.
I use a check if the named tab/sheet is available:
If IsError(Evaluate("SHEETNAME!A1")) Then
'Nothing
Else
Sheets("SHEETNAME").Delete
End If
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "SHEETNAME"
Or as suggested by Scott to have it be simpler and cleaner:
If Not IsError(Evaluate("SHEETNAME!A1")) Then Sheets("SHEETNAME").Delete
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "SHEETNAME"
Edit 1:
Application.DisplayAlerts = False
If IsError(Evaluate("SHEETNAME!A1")) Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "SHEETNAME"
Application.DisplayAlerts = True
[W]hen I create another tab "accidentally" with same name it gives me error . . . I don't want to create one more tab with same name. Instead it should stop me from creating tabs with same name
This is not an uncommon problem with macros that create tabs--it is easy to accidentally run them twice. To prevent this, first check to see if the tab already exists and only after verifying that it doesn't exist, call the Worksheets.Copy method.
Private Sub Filling_List()
Dim sPath As String
Dim sFile As String
Dim wb As Workbook
Dim sName As String 'add sName declaration
Dim wb1 As Workbook
Dim ws1 As Worksheet
Set wb1 = ThisWorkbook
Set ws1 = ThisWorkbook.Worksheets("S0")
Application.ScreenUpdating = False
sPath = "C:\Users\arp\Desktop\Filling list macro\"
sFile = sPath & "ArF Filling List.xlsm"
Set wb = Workbooks.Open(sFile)
sName = ws1.Range("A1") & " " & ws1.Range("T2")
On Error Resume Next
Dim wslTest As Worksheet
Set wslTest = wb.Worksheets(sName)
If Err.Number = 0 Then
MsgBox "Tab: " & sName & " already exists.", vbInformation
wslTest.Activate
Exit Sub
End If
On Error GoTo 0
wb.Worksheets("ArF Templete").Copy After:=wb.Worksheets(wb.Worksheets.Count)
wb.ActiveSheet.Name = sName
' rest of code
End Sub
The code below should do what you want, you may need to adapt it for your project.
Option Explicit
Sub addsheet()
Dim sht As Worksheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.add
On Error Resume Next 'Prevent Excel from stopping on an error but just goes to next line
ws.Name = "Sheet1"
If Err.Number = 1004 Then
MsgBox "Worksheet with this name already exists"
Application.DisplayAlerts = False 'Prevent confirmation popup on sheet deletion
ws.Delete
Application.DisplayAlerts = True 'Turn alerts back on
On Error GoTo 0 'Stop excel from skipping errors
Exit Sub 'Terminate sub after a failed attempt to add sheet
End If
On Error GoTo 0 'Stop Excel from skipping errors.
End Sub
Please help me to to change the below code. Need to select the renaming cell through InputBox
Thanks
Sub RenWSs()
Dim WS As Worksheet
Dim shtName
Dim newName As String
Dim i As Integer
For Each WS In Worksheets
With WS
If Trim(.Range("c14")) <> "" Then
shtName = Split(Trim(.Range("c14")), " ")
newName = shtName(0)
On Error GoTo ws_name_error
.Name = newName
GoTo done
repeat:
.Name = newName & i
GoTo done
ws_name_error:
i = i + 1
Resume repeat
End If
End With
On Error GoTo 0
done:
Next
End Sub
There are a few ways you can use the InputBox to access Cell C4.
One is by selecting a String in the InputBox , see code below:
Dim RngStr As String
RngStr = Application.InputBox(prompt:="Select the Cell for the new Sheet's name", Type:=2)
If Trim(.Range(RngStr)) <> "" Then
Another, is by selecting a Range in the InputBox, see code below:
Dim rng As Range
Set rng = Application.InputBox(prompt:="Select the Cell for the new Sheet's name", Type:=8)
If Trim(rng) <> "" Then
Full Code
Option Explicit
Sub RenWSs()
Dim WS As Worksheet
Dim shtName
Dim newName As String
Dim i As Integer
Dim RngStr As String
RngStr = Application.InputBox(prompt:="Select the Range for the new Sheet's name", Type:=2)
For Each WS In Worksheets
With WS
If Trim(.Range(RngStr)) <> "" Then
shtName = Split(Trim(.Range(RngStr)), " ")
newName = shtName(0)
On Error GoTo ws_name_error
.Name = newName
GoTo done
repeat:
.Name = newName & i
GoTo done
ws_name_error:
i = i + 1
Resume repeat
End If
End With
On Error GoTo 0
done:
Next
End Sub
To read more about InputBox functionality: https://msdn.microsoft.com/en-us/library/office/ff839468.aspx
Using Excel 2013 macros I'd like to be able to, upon worksheet creation (the "+" sign or right click, new worksheet), to instead of creating a new worksheet, copy a hidden "TEMPLATE" worksheet instead to use as a template for this workbook. There will be many worksheets to be created initially and over time, this workbook will be used every day with potentially other workbooks open at the same time as well.
The code I already have asks for the user to input the name of the worksheet upon creation and calls to sort the current workbook's worksheets alphanumerically and rebuild the TOC. Is there any way to change the current code to match it's new purpose? NOTE: This code is in ThisWorkbook.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim sName As String
Dim bValidName As Boolean
Dim i As Long
bValidName = False
Do While bValidName = False
sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
If Len(sName) > 0 Then
For i = 1 To 7
sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
Next i
sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
End If
Loop
Sh.Name = sName
Call Sort_Active_Book
Call Rebuild_TOC
End Sub
Edit 1:
Note: The "TEMPLATE" worksheet only pertains to this workbook, does not need to be used in another workbook, and is a hidden worksheet in this workbook.
Updated code. GSerg has it right:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim wb as Workbook
Dim wsTemp as Worksheet
Dim sName As String
Dim bValidName As Boolean
Dim i As Long
bValidName = False
Do While bValidName = False
sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
If Len(sName) > 0 Then
For i = 1 To 7
sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
Next i
sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
End If
Loop
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set wb = ThisWorkbook
Set wsTemp = wb.Sheets("TEMPLATE")
wsTemp.Visible = xlSheetVisible
wsTemp.Copy After:=wb.Sheets(wb.Sheets.Count)
ActiveSheet.Name = sName
Sh.Delete
wsTemp.Visible = xlSheetHidden 'Or xlSheetVeryHidden
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
Call Sort_Active_Book
Call Rebuild_TOC
End Sub
Is your template saved a location you could pull from for anyone who needs it? If not you will just have to create a macro to format a template.
If you have a template ready, you just need the full path of that file. I would turn off application.screenupdating = false and open that file, copy the sheet you want and paste it to your current doc, then close the template file and application.screenupdating = true.
Edit:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Template").Visible = True
sheets("Template").copy after:=Sheets(1)
Sheets("Template").Visible = False
ActiveSheet.Name = sName
Sheets(Sh.Name).Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
This will work, you will just need to change the template path
VBA novice here - I've combed the interwebs and can't seem to get this to work, it's got me stumped.
I would like to have a button on a form that will allow a user to generate a copy of a worksheet "Template", in the same workbook - to the right of "Template". I've figured it out enough that I can generate a copy that renames itself as Template(2) OR generate a blank worksheet named with the text entered in the prompt, but I can't do both.
As is below - it currently returns an "Object Required" error. Thanks in advance for your help, it's much appreciated!
Private Sub NewSheet()
Dim NewSheet As Worksheet
Dim newName As String
Do
newName = Application.InputBox("What do you want to name the new sheet?", Type:=2)
If newName = "False" Then Exit Sub: Rem cancel pressed
Set NewSheet = ThisWorkbook.Worksheets("Template").Copy(After:=Worksheets("Template"))
On Error Resume Next
NewSheet.Name = newName
newName = Error
On Error GoTo 0
If newName <> vbNullString Then
Application.DisplayAlerts = False
NewSheet.Delete
Application.DisplayAlerts = True
MsgBox newName
End If
Loop Until newName = vbNullString
End Sub
Or you can try this:
Sub Test()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Template")
Dim newws As Worksheet, sh As Worksheet, newname
Dim query As Long, xst As Boolean, info As String
retry:
xst = False
newname = Application.InputBox("Enter a new sheet name.", info, , , , , , 2)
If newname = "False" Then Exit Sub
For Each sh In wb.Sheets
If sh.Name = newname Then
xst = True: Exit For
End If
Next
If Len(newname) = 0 Or xst = True Then
info = "Sheet name is invalid. Please retry."
GoTo retry
End If
ws.Copy after:=ws: Set newws = ActiveSheet: newws.Name = newname
End Sub
This will continuously ask for a valid sheet name unless the user cancels it.
To avoid deleting a newly added sheet, check first if the name is valid.
Also, I don't think you can copy and assign in one go since there's no documentation that the Copy Method returns the object that was copied. So you copy first and use Activesheet to assign it to a variable.