Hi
I'm using the below vba syntax to insert sheet if it meets the criteria. The problem is that after sheet10 - I get error message that The name is already taken. Try a difference one.
Please can someone help me.
Thank you
I'm using the below vba syntax to insert sheet if it meets the criteria. The problem is that after sheet10 - I get error message that The name is already taken. Try a difference one.
Please can someone help me.
Thank you
Code:
If Target.CountLarge > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, Range("E8:E151")) Is Nothing Then
If IsNumeric(Target.Value) Then
If Abs(Target.Value) >= 20 Then
Select Case Cells(Target.Row, "D").Value
Case 1, 2, 3, 4, 5, 10, 13
Dim sh1 As Worksheet, sh2 As Worksheet, sName As String, newName As String
Dim hyShape As Shape
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set sh1 = ActiveSheet
Set sh2 = Sheets(1)
newName = sh2.Range("A2").Value & NextSheetName(sh2.Range("A2").Value)
If newName = "" Then
MsgBox "Invalid Sheet Name"
Exit Sub
End If
On Error Resume Next
'Sheets(newName).Delete
On Error GoTo 0
sh2.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = newName
sh1.Select
ActiveSheet.Unprotect Password:="1234"
With sh1.Range("J" & Target.Row)
Set hyShape = sh1.Shapes.AddShape(msoShapeRectangle, .Left + 1, .Top + 1, .Width - 2, .Height - 2)
sh1.Hyperlinks.Add Anchor:=hyShape, Address:="", SubAddress:="'" & newName & "'!A1", ScreenTip:=""
hyShape.TextFrame.Characters.Text = "View"
ActiveSheet.Protect Password:="1234"
End With
End Select
End If
End If
End If
End Sub
Function NextSheetName(NM As String)
maxName = 0
For Each WKS In ThisWorkbook.Worksheets
tempName = Replace(WKS.Name, NM, "")
If IsNumeric(tempName) Then
If tempName > maxName Then maxName = tempName
End If
Next
NextSheetName = maxName + 1
End Function