Microsoft Excel VBA Intersect with Rename Sheet-CodePudding

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

CodePudding user response：

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

CodePudding user response：

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
 Option 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