How to add shapes to a new sheet which will be dynamically added before

I am writing a code to create a new sheet with a user defined name and code name. Then add multiple shapes with user defined text inside the shapes in new sheet vertically down. The number of shapes will be based on number of cells selected by user in the 1st sheet. When I try run the written code for adding shapes in new sheet "Run time error '438' Object does not support this property or method" pops up. I tried running the same code with existing sheet and it runs fine. Can someone help identify the error and provide solution?

PS: I'm not coder so little layman language solution would help. The code is attached and debugging line is Set S = BN.Shapes.AddShape(msoShapeRectangle, 20, a, 200, 100). The existing sheet codename is "Tool" and the new sheet codename which will be added is based on user input defined with variable BN.

Sub Prepare_Bowtie()

Tool.Select
Cells(1, 1).Select
'Ask for Bowtie Number
Dim BN As Range
Set BN = Application.InputBox("Select Cell with Bowtie Number", "Bowtie preparation - Bowtie Number", Type:=8)

If BN = vbNullString Then
MsgBox "No Cell Selected"

Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = BN

With ActiveSheet
.Parent.VBProject.VBComponents(.CodeName).Properties("_CodeName") = BN
End With

Tool.Select

On Error GoTo 0
End If

Dim Threat As Variant
Threat = Application.InputBox("Select all cells with threats", "Bowtie preparation - Threat Selection", , , , , , 8)

Dim a As Long
Dim S As Shape
a = 20
For Each Threat In Selection

Set S = BN.Shapes.AddShape(msoShapeRectangle, 20, a, 200, 100)
S.Fill.ForeColor.RGB = RGB(0, 0, 0)

S.TextFrame.Characters.Text = Threat

With S.TextFrame.Characters.Font
.Color = RGB(255, 255, 255)
.Size = 15
.Name = "Calibri"
End With

With S.TextFrame
.Orientation = msoTextOrientationHorizontal
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With

a = a + 150
Next Threat

On Error Resume Next
Sheets(BN).Delete
On Error GoTo 0

End Sub

Solution

Please, test the next adapted code:

Sub Prepare_Bowtie()
 Dim Tool As Worksheet, BN As Range, newSh As Worksheet, Threat As Variant
 Dim rngTreat As Range, a As Long, S As Shape
 Set Tool = ActiveSheet
 Tool.Activate

Reselect:  'for the case of wrongly selected a cell containing an existing Bowtie Number
 'Ask for Bowtie Number
 Set BN = Application.InputBox("Select Cell with Bowtie Number (only one cell!)", "Bowtie preparation - Bowtie Number", Type:=8)

 If BN Is Nothing Then
    MsgBox "No Cell Selected": Exit Sub
 ElseIf BN.cells.count > 1 Then
    MsgBox "More then one cell Selected": Exit Sub
 ElseIf BN.Value = "" Then
   MsgBox "Empty cell Selected": Exit Sub
 End If

 If newSh Is Nothing Then 'in case of GoTo Reselect...
    Set newSh = Sheets.Add(After:=Sheets(Sheets.count)) 'set the added sheet
 End If
 With newSh
    On Error Resume Next
    .Name = BN
    If err.Number = 1004 Then
        err.Clear: On Error GoTo 0
        MsgBox "A sheet named """ & BN & """ already exists..." & vbCrLf & _
                   "Please, select another cell for the Boutie Number!": Tool.Activate: GoTo Reselect
    End If
    On Error GoTo 0
    .Parent.VBProject.VBComponents(.CodeName).Properties("_CodeName") = BN
 End With

 Tool.Activate
 Set rngTreat = Application.InputBox("Select all cells with threats", "Bowtie preparation - Threat Selection", , , , , , 8)

 a = 20
 For Each Threat In rngTreat
    Set S = newSh.Shapes.AddShape(msoShapeRectangle, 20, a, 200, 100)
    With S
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .TextFrame.Characters.Text = Threat
    
        With .TextFrame.Characters.Font
            .color = RGB(255, 255, 255)
            .Size = 15
            .Name = "Calibri"
        End With
    
        With .TextFrame
            .Orientation = msoTextOrientationHorizontal
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
    End With
    a = a + 150
 Next Threat

 On Error Resume Next
   Sheets(BN).Delete 'this will never work! BN cannot be called in the same sub where it has been defined...
   'newSh.Delete      'if you want deleting it, uncomment this line
 On Error GoTo 0
End Sub

The main issue is the fact that a sheet CodeName change in the way your code does, cannot be used in the Sub where it has been changed.

Then, this approach For Each Threat In Selection to work, such a selection is necessary. Since your code started by selecting "A1" cell, it remains as selection. You must understand that selecting a range to create the InputBox one, does not remain as selection.

I also treaded in a different way first InputBox checking. It is a range and cannot be checked against nullString. Please, try understanding what I used, it is not complicated to be understood.

The new sheet naming way is a little improved, for the case of an existing sheet name may be the same with the tried one.

If something unclear, please not hesitate to ask for clarifications.