Sheet copying error

ashani

Board Regular
Joined
Mar 14, 2020
Messages
152
Office Version
  1. 365
Platform
  1. Windows
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

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
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,025
Is this a worksheet_change event?

Use the xl2bb add-in to show what the data looks like.

1601695212940.png
 

ashani

Board Regular
Joined
Mar 14, 2020
Messages
152
Office Version
  1. 365
Platform
  1. Windows
Thank you @davesexcel
Thank you for the quick reply. Unfortunately my system doesn't allow me download xl2bb however here is the screen shot.

So on sheet 1 when I put 1 and 20, it copied over the sheet called "NOT TO BE USED" with serial number 1, 2, 3 and so on. however the issue I have is after 10th sheet it comes up with the above error message, not sure why ?
 

Attachments

  • Screenshot 2020-10-03 at 17.07.13.png
    Screenshot 2020-10-03 at 17.07.13.png
    219.5 KB · Views: 4

Watch MrExcel Video

Forum statistics

Threads
1,114,002
Messages
5,545,439
Members
410,684
Latest member
LakTik
Top