Loop until No Error

[DenverWill81]

Long time reader, first time poster!

I'm trying to create a Loop that names a sheet based on a cell value. If the sheet name already exists then the macro will pop up a message box with an entry field to enter a new name and that will Loop until the user enter a sheet name that isn't already taken. Here's what I've got...

Sub NameSheet()
'
' The idea is to copy the HDS Import Template and make an attempt to rename it based on the value of "IMPORT_ProjectName". If there's already a sheet with that name _
' then you get a Message Box where you can enter a new name. The macro then attempts to use the new name but if it too exists then it loops back up to the Message Box _
' until you enter a name that doesn't yet exist. I just can't quite get the Do Until / Loop function figured out.

' IMPORT HDS
    ' Set Project Name
        Dim PN As range
        Set PN = range("IMPORT_ProjectName")
       
    ' Copy HDSImport Template and Rename
        Sheets("HDS Import Template").Copy After:=Sheets(Sheets.Count)
       
        On Error GoTo PNmsgbox
        ActiveSheet.Name = PN
   
        GoTo HDSSuccess

PNmsgbox:
   ' Do until... No Error???
    Dim strInput As String
    strInput = InputBox(range("IMPORT_ProjectName").Value & " already exists." & vbNewLine & vbNewLine & "Please enter a new name in the box below or click Cancel", "Project Name", "")
    range("IMPORT_ProjectName").Value = strInput
   
    On Error GoTo NextLoop
   
    ActiveSheet.Name = PN
    GoTo HDSSuccess

NextLoop:

    ' Loop...

HDSSuccess:

End Sub

 

[Micron]

I dunno if Excel users consider controlling flow with several GoTo statements but Access developers generally do.
I'd try Resume in NextLoop: but to be honest, I think it deserves a rewrite. If you want to tell me what the error number would be I'll take a stab at it. You can comment out your error handling lines to raise the error if you don't know what the error number is.

 

[DenverWill81]

So the error occurs at ActiveSheet.Name = PN when there's already a sheet named the referred to cell's value.
Once the initial error occurs the message box pops up where you can enter a new name. It then tries to use the new name, again with ActiveSheet.Name = PN, if that too is an error then it should loop back to the start of the loop and trigger the message box again. If it's not an error it should jump out of the loop via GoTo HDSSuccess.

Unfortunately I'm entering this from my phone so I don't have access to the error code. I'll pay it ASAP.

 

[Fluff]

How about

Sub DenverWill()
   Dim ShtName As String
   
   ShtName = Range("IMPORT_ProjectName").Value
   Do Until Not Evaluate("isref('" & ShtName & "'!A1)")
      ShtName = InputBox(ShtName & " already exists." & vbNewLine & vbNewLine & "Please enter a new name in the box below or click Cancel", "Project Name", "")
      If ShtName = "" Then Exit Sub
   Loop
   Sheets("HDS Import Template").Copy After:=Sheets(Sheets.Count)
   ActiveSheet.Name = ShtName
End Sub

 

[Micron]

Seems I learn of something new here each day. Will have to look up Evaluate.
I had written an approach that used error handling and seemed to find that error 1004 has more than one message as noted in the code. Will have to look into that as well.

Sub NameSheet()
Dim strName As String

On Error GoTo PNmsgbox
' Copy HDSImport Template and Rename
Sheets("HDS Import Template").Copy After:=Sheets(Sheets.count)
strName = Range("IMPORT_ProjectName")
ActiveSheet.Name = strName

exitHere:
Exit Sub

PNmsgbox:
'Error number seems to be 1004, which seems to have more than one message, so use message, not number
If err.Description = "That name is already taken. Try a different one." Then
   strName = InputBox(Range("IMPORT_ProjectName").Value & " already exists." & vbNewLine & vbNewLine _
   & "Please enter a new name in the box below or click Cancel", "Project Name", "")
   If strName = "" Then Exit Sub
   Resume
Else
   MsgBox "Error " & err.Number & ": " & err.Description
End If

End Sub

 

[DenverWill81]

How about

Sub DenverWill()
   Dim ShtName As String
  
   ShtName = Range("IMPORT_ProjectName").Value
   Do Until Not Evaluate("isref('" & ShtName & "'!A1)")
      ShtName = InputBox(ShtName & " already exists." & vbNewLine & vbNewLine & "Please enter a new name in the box below or click Cancel", "Project Name", "")
      If ShtName = "" Then Exit Sub
   Loop
   Sheets("HDS Import Template").Copy After:=Sheets(Sheets.Count)
   ActiveSheet.Name = ShtName
End Sub

Wow - that works perfectly. I can't tell you how much time I put into figuring this out... Thank you!

 

[Fluff]

Glad we could help & thanks for the feedback.