I have created my worksheet with a template sheet. I also create a button to copy the template sheet and put any new created sheets after the template sheet.
Everything is still OK if the 'Template' is visible. When I hide the 'Template', only the latest created sheet is visible, other are auto hidden.
Could you please have a look at my script and advise me how to fix that? I want any new created sheet will be visible and put after the hidden template sheet.
Here is my script
Sub NewSheet()
Dim newWS As Worksheet
Dim TemplateWS As Worksheet
Dim newWSName As String
Retry:
newWSName = InputBox("Enter Activity name.", "New Sheet Name")
If newWSName = "" Then Exit Sub
For Each ws In Worksheets
If ws.Name = newWSName Then
MsgBox newWSName & " exist already. Pick another name.", vbExclamation, "Sheet Name Exists"
GoTo Retry
End If
Next ws
Set TemplateWS = Sheet7
TemplateWS.Activate
TemplateWS.Copy After:=ActiveWorkbook.Sheets("template 1")
ActiveSheet.Name = newWSName
Range("A1").Select
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Summary'!A1", TextToDisplay:="Click to Summary"
ActiveSheet.Tab.ColorIndex = 19
End Sub
Thank you so much as always.
Normally a copied sheet becomes the active sheet but this doesn't happen if the copied sheet is hidden. Solution is to make template visible, copy and then hide.
Option Explicit
Sub NewSheet()
Dim wsTemplate As Worksheet, ws As Worksheet
Dim newWSName As String
Retry:
newWSName = InputBox("Enter Activity name.", "New Sheet Name")
If newWSName = "" Then Exit Sub
For Each ws In ThisWorkbook.Sheets
If ws.Name = newWSName Then
MsgBox newWSName & " exist already. Pick another name.", vbExclamation, "Sheet Name Exists"
GoTo Retry
End If
Next ws
Set wsTemplate = Sheets("Template 1")
wsTemplate.Visible = True
wsTemplate.Copy After:=wsTemplate
With ActiveSheet
.Name = newWSName
.Range("A1").Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="'Summary'!A1", _
TextToDisplay:="Click to Summary"
.Tab.ColorIndex = 19
End With
wsTemplate.Visible = False
End Sub
Related
I have created a button that would create a new sheet which works just fine. However, when I created a new sheet with the function, it relocates or redirect me to that new sheet which make. I also have a delete button in which it just accepts the sheet name and delete it instantly with no redirection or relocating. Is there a way to prevent the redirecting from happening? I am still a beginner so if I am doing something wrong, pls kindly correct me! Thanks in advance.
Here is the code.
Option Explicit
Public sheetName As Variant
Sub AddSheet()
On Error Resume Next
sheetName = InputBox("New Sheet Name", "Prototype 01")
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
End If
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetName
MsgBox "" & sheetName & " was successfully created!"
End Sub
Sub DeleteSheet()
On Error Resume Next
sheetName = InputBox("Sheet Name", "Prototype 01")
If sheetName = "" Then Exit Sub
Sheets(sheetName).Delete
MsgBox """" & sheetName & """ was successfully removed!"
End Sub
Yo can switch sheets via Worksheet.Activate function of vba.
Sheets("YourSheetName").Activate
Once you create the new sheet, add this code to return back to your original sheet.
Add a Worksheet or Delete a Sheet
It is assumed that the delete code will be called by a button so the active sheet (the one with the button) cannot accidentally be deleted.
Add
Option Explicit
Sub AddSheet()
Const PROC_TITLE As String = "Add Sheet"
If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
Dim aws As Worksheet: Set aws = ActiveSheet
Dim wb As Workbook: Set wb = aws.Parent
Dim SheetName As String
SheetName = InputBox("Enter name of sheet to be ADDED", PROC_TITLE)
If Len(SheetName) = 0 Then
MsgBox "Sheet name cannot be empty!", _
vbCritical, PROC_TITLE
Exit Sub
End If
Dim nws As Worksheet
Set nws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
Dim ErrNum As Long
On Error Resume Next ' invalid or existing sheet name
nws.Name = SheetName
ErrNum = Err.Number
On Error GoTo 0
Dim IsSuccess As Boolean
If ErrNum = 0 Then
IsSuccess = True
Else
Application.DisplayAlerts = False
nws.Delete
Application.DisplayAlerts = True
End If
aws.Select
If IsSuccess Then
MsgBox "Worksheet """ & SheetName & """ successfully added.", _
vbInformation, PROC_TITLE
Else
MsgBox "Could not rename to """ & SheetName & """.", _
vbCritical, PROC_TITLE
End If
End Sub
Delete
Sub DeleteSheet()
Const PROC_TITLE As String = "Delete Sheet"
If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
Dim aws As Worksheet: Set aws = ActiveSheet
Dim wb As Workbook: Set wb = aws.Parent
Dim SheetName As String
SheetName = InputBox("Enter name of sheet to be DELETED", PROC_TITLE)
If Len(SheetName) = 0 Then
MsgBox "Sheet name cannot be empty!", _
vbCritical, PROC_TITLE
Exit Sub
End If
Dim dsh As Object ' allowing charts to be deleted
On Error Resume Next
Set dsh = wb.Sheets(SheetName)
On Error Resume Next
If dsh Is Nothing Then
MsgBox "There is no sheet named """ & SheetName & """!", _
vbCritical, PROC_TITLE
Exit Sub
End If
' Don't delete the ActiveSheet, the one with the buttons.
If dsh Is aws Then
MsgBox "Cannot delete the 'button' worksheet """ & aws.Name & """!", _
vbCritical, PROC_TITLE
Exit Sub
End If
' A very hidden sheet cannot be deleted. There is no error though.
If dsh.Visible = xlSheetVeryHidden Then
MsgBox "Cannot delete the very hidden sheet """ & SheetName & """!", _
vbCritical, PROC_TITLE
Exit Sub
End If
Application.DisplayAlerts = False
dsh.Delete
Application.DisplayAlerts = True
aws.Select
MsgBox "Sheet """ & SheetName & """ successfully deleted.", _
vbInformation, PROC_TITLE
End Sub
With the help of the below code, I am trying to add a new sheet in excel with the name as the name given by the user. I need the sheet to be created with the name also getting added on the cell (1,1) of the Added sheet?
Dim sheetName As String
Dim shExists As Boolean
Do
sheetName = InputBox("Name of sheet", "Add sheet")
If sheetName <> "" Then
shExists = SheetExists(sheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetName
MsgBox "The sheet " & (sheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already present, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
Else
MsgBox "Please enter the OSAT", vbOKOnly + vbInformation, "Warning"
'Exit Sub
End If
Loop Until Not shExists Or sheetName = ""
End Sub
You can assign the new sheet to a variable to get access to it:
Dim ws As Worksheet
With ThisWorkbook
Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
End With
With ws
.Name = sheetname
.Cells(1, 1) = sheetname
End With
Furthermore I am referencing the workbook where the sheet should be created, explicitly by ThisWorkbook (=workbook containing the code). This makes the code more reliable.
Template sheet labeled = "COQ 001"
Log labeled = "Change Order Log"
I have gotten this far: Code below creates a new sheet based off of the template labeled "COQ 001", renames the new worksheet based on user input, goes back to the change order log and sets it to active, inserts a row after the last entry. I think I got that right.
Sub CreateSheet()
Dim xName As String
Dim xSht As Object
On Error Resume Next
xName = InputBox("Please enter new COQ #. For Example: COQ 001", "NEW CHANGE ORDER QUOTE")
If xName = "" Then Exit Sub
Set xSht = Sheets(xName)
If Not xSht Is Nothing Then
MsgBox "Sheet cannot be created as there is already a worksheet with the same name in this
workbook"
Exit Sub
End If
Sheets("COQ 001").Copy after:=Sheets(Sheets.Count)
Set xNWS = Sheets(Sheets.Count)
xNWS.Name = xName
'Link2Log Macro
Worksheets("Change Order Log").Activate
'Locates Last Cell
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
'Inserts Row Below
Range("10:10").EntireRow.Insert
End Sub
To keep going I need it to link specific cells of each newly created worksheet to the change order log sheet since that is my master log. Instead of COQ 001 which shows up on the formula, I would like it to be each newly created sheet.
If anyone can help finish the thought that would be great!!Thanks,
New Formula:
Thanks Nick, this is what the formula looks like:
Sub CreateSheet()
Dim xName As String
Dim xSht As Object
On Error Resume Next
xName = InputBox("Please enter new COQ #. For Example: COQ 001", "NEW
CHANGE ORDER QUOTE")
If xName = "" Then Exit Sub
Set xSht = Sheets(xName)
If Not xSht Is Nothing Then
MsgBox "Sheet cannot be created as there is already a worksheet with
the same name in this workbook"
Exit Sub
End If
Sheets("COQ 001").Copy after:=Sheets(Sheets.Count)
Set xNWS = Sheets(Sheets.Count)
xNWS.Name = xName
'Link2Log Macro
Worksheets("Change Order Log").Activate
Range("10:10").EntireRow.Insert
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.FormulaR1C1 = "='xName'!R[-3]C[5]"
Range("C10").Select
ActiveCell.FormulaR1C1 = "='xName'!R[2]C:R[2]C[5]"
Range("D10").Select
ActiveCell.FormulaR1C1 = "='xName'!R[-2]C[3]"
Range("E10").Select
ActiveCell.FormulaR1C1 = "='xName'!R[-1]C[2]"
Range("G10").Select
ActiveCell.FormulaR1C1 = "='xName'!R[40]C"
Range("G11").Select
End Sub
But I get an error on the log:
LOG
You can try this:
Sub CreateSheet()
Dim xName As String, wb As Workbook
Dim ws As Worksheet
xName = InputBox("Please enter new COQ #. For Example: COQ 001", _
"NEWCHANGE ORDER QUOTE")
If xName = "" Then Exit Sub
Set wb = ThisWorkbook
If SheetExists(xName, wb) Then
MsgBox "Sheet '" & xName & "' cannot be created as there is already " & _
"a worksheet with the same name in this workbook"
Exit Sub
End If
wb.Worksheets("COQ 001").Copy after:=Sheets(Sheets.Count)
Set ws = wb.Sheets(Sheets.Count)
ws.Name = xName
With wb.Worksheets("Change Order Log")
.Activate
.Cells(Rows.Count, "B").End(xlUp).Offset(1).EntireRow.Insert 'add a row to the table
With .Cells(Rows.Count, "B").End(xlUp).Offset(1).EntireRow
.Columns("B").Formula = "='" & xName & "'!G7"
.Columns("C").Formula = "='" & xName & "'!C12" 'only need first cell of merged area
.Columns("D").Formula = "='" & xName & "'!G8"
.Columns("E").Formula = "='" & xName & "'!G9"
.Columns("G").Formula = "='" & xName & "'!G50" 'likewise
End With
End With
End Sub
Function SheetExists(SheetName As String, Optional wb As Excel.Workbook)
Dim s As Excel.Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set s = wb.Sheets(SheetName)
On Error GoTo 0
SheetExists = Not s Is Nothing
End Function
Note you don't need to select/activate ranges to work with them - just reference them directly.
I need to be able to auto add a Hyperlink to a worksheet in the same workbook.
The code below created a new report and names it according to the active cell on the Main page.
I want to Hyperlink that cell to the newly created sheet with the same name.
Sub New_sheet()
Dim ShtName As String
Application.DisplayAlerts = False
On Error GoTo ErrMsg
ShtName = ActiveCell.Value2 ' <-- save the value of the ActiveCell
Set ws = Sheets("Blank incident tab")
ws.Copy After:=Sheets("Incident Catagories")
Set wsNew = Sheets(Sheets("Incident Catagories").Index + 1)
wsNew.Name = ShtName
Exit Sub
ErrMsg:
MsgBox ("That incident report already Exsists, Please chaeck and open a new incident"), , "Error Duplicate incident"
Sheets("Blank incident tab (2)").Delete
Application.DisplayAlerts = True
End Sub
I have developed a code to copy a sheet and rename the sheet name with the value given in the insert box and then copy the same value in the summary sheet and select the last cell and paste the value but I want to create the hyperlink so that if i click on that value it will take me to that sheet.
I am stuck at the giving the proper subaddress.
Private Sub CommandButton1_Click()
Dim sName As String
Dim oRng As Range
sName = InputBox("New Shipment", "New AWB Number", "Enter the AWB Number")
If sName <> "" Then
ThisWorkbook.Sheets("Templete").Copy Before:=Sheets(3)
ActiveSheet.Name = sName
MsgBox "New AWB Number Tracking Added"
Else
MsgBox "Failed"
End If
Sheets("Summary").Select
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Activate
ActiveCell.Value = sName
'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'Sheet(3)'!A1"
End Sub
When I run this I am getting an error:
"Reference isn't valid"
Please help.
You can always run into issues when using Select and Activate but I suspect your main issue was your hyperlink sub address. You where trying to set it to 'Sheet(3)'!A1" which excel won't recognise as it is the sheet position (which VBA recognises) rather than the sheet name. Have a look at the below
Private Sub CommandButton1_Click()
Dim sName As String
Dim oRng As Range
Dim nWs As Worksheet
sName = InputBox("New Shipment", "New AWB Number", "Enter the AWB Number")
If sName <> "" Then
With ThisWorkbook
.Sheets("Templete").Copy Before:=.Sheets(3)
Set nWs = .Sheets(3)
End With
nWs.Name = sName
With Sheets("Summary")
With .Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
.Value2 = sName
.Parent.Hyperlinks.Add Anchor:=.Cells, Address:="", SubAddress:= _
"'" & nWs.Name & "'!A1"
End With
End With
MsgBox "New AWB Number Tracking Added"
Else
MsgBox "Failed"
End If
End Sub
You should probably also add to this a check to test against existing sheets for duplicate or invalid names entered by the user.