Microsoft Excel VBA Intersect with Rename Sheet - excel

Question

I'm trying to change the name of a sheet after it is created under and Intersect method. The code I have below give Error 424. The code works when only creating a new sheet.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Set Active_Range = Range("B6:F11")
If Not Application.Intersect(Target, Active_Range) Is Nothing Then
Sheets("Employee Details").Copy after:=Sheets("Job Schedule")
Sheets("Employee Details (2)").Name.Value = "Name One"
End If
End Sub
I have tried creating a trigger for the workbook that renames the new sheet when it is created but that does not work either.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Name.Value = "Name One"
End Sub

Answer 1

Is this what you are trying? (Not fully tested)
Option Explicit
Private Sub Workbook_NewSheet(ByVal Sh As Object)
'~~> This is the name that you want to give
Dim Nm As String
Nm = "Name One"
'~~> Check if this name is already taken
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(Nm)
On Error GoTo 0
If Not ws Is Nothing Then
'~~> Name the new worksheet
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Nm
Else
'~~> Alert user and delete the newly created sheet
MsgBox "This name is already taken"
Application.DisplayAlerts = False
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Delete
Application.DisplayAlerts = True
End If
End Sub

Answer 2

sticking to your "Workbook_NewSheet" approach
in any Module code pane, put this at the very top
Option Private Module ' make the Public variables "local" to current VBA project only
Public newSheetName As String ' this variable will be available to any other Sub, Function of this Project
in ThisWorkbook code pane, put this
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Name = newSheetName
End Sub
in your relevant Worksheet code pane, put this
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Active_Range As Range
Set Active_Range = Range("B6:F11")
If Not Application.Intersect(Target, Active_Range) Is Nothing Then
newSheetName = "Name One" ' set the public variable
Sheets("Employee Details").Copy after:=Sheets("Job Schedule")
End If
End Sub
After that, you may want to add code (I'd do that in "Workbook_NewSheet()" to ensure the new worksheet name:
a) matches the sheet name rules
b) isn't already used for another sheet in the same workbook

Answer 3

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Active_Range As Range
Set Active_Range = Range("B6:F11")
If Not Application.Intersect(Target, Active_Range) Is Nothing Then
Name2 = ActiveCell().Value
Sheets("Employee Details").Copy After:=Sheets("Job Schedule")
Worksheets("Employee Details (2)").Name = "Employee Details - " + Name2
End If
End Sub
Above is what I came up with after digging and reading a little more.

Answer 4

A Worksheet BeforeRightClick: Copy and Rename Template Worksheet
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
AddNewEmployeeDetails Target, Cancel
End Sub
Standard Module e.g. Module1
Option Explicit
Sub AddNewEmployeeDetails(ByVal Target As Range, ByRef Cancel As Boolean)
Const PROC_TITLE As String = "Add New Employee Details Sheet"
Const TARGET_RANGE As String = "B6:F11"
Const SRC_SHEET_NAME As String = "Employee Details"
Const AFTER_SHEET_NAME As String = "Job Schedule"
Const DST_SHEET_NAME_PREFIX As String = "Employee Details - "
Dim tws As Worksheet: Set tws = Target.Worksheet
Dim trg As Range: Set trg = Intersect(tws.Range(TARGET_RANGE), Target)
If trg Is Nothing Then Exit Sub
Dim eName As String: eName = CStr(Target.Value) ' for the message boxes
Dim dName As String: dName = DST_SHEET_NAME_PREFIX & eName
Dim wb As Workbook: Set wb = tws.Parent
Dim dsh As Object
On Error Resume Next ' to prevent error if sheet doesn't exist
Set dsh = wb.Sheets(dName)
On Error GoTo 0
If dsh Is Nothing Then ' sheet doesn't exist
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET_NAME)
Dim aws As Worksheet: Set aws = wb.Sheets(AFTER_SHEET_NAME)
sws.Copy After:=aws
Dim dws As Worksheet: Set dws = aws.Next
Dim ErrNumber As Long, ErrDescription As String
On Error Resume Next ' to prevent error if invalid sheet name
dws.Name = dName
ErrNumber = Err.Number
ErrDescription = Err.Description
On Error GoTo 0
If ErrNumber <> 0 Then ' sheet name is invalid
Application.DisplayAlerts = False ' to delete without confirmation
dws.Delete
Application.DisplayAlerts = True
tws.Select
MsgBox "Run-time error '" & ErrNumber & "':" & vbLf & vbLf _
& ErrDescription & vbLf & vbLf & "Could not rename to """ _
& dName & """.", vbCritical, PROC_TITLE
Else ' sheet name is valid
MsgBox "Employee Details sheet for " & eName & " added.", _
vbInformation, PROC_TITLE
End If
Else ' sheet exists
MsgBox "The Employee Details sheet for " & eName _
& " already exists.", vbCritical, PROC_TITLE
End If
Cancel = True
End Sub