Loop until No Error

DenverWill81

New Member
Joined
Apr 29, 2022
Messages
7
Office Version
  1. 2016
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...

VBA Code:
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
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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.
 
Upvote 0
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.
 
Upvote 0
How about
VBA Code:
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
 
Upvote 0
Solution
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.
VBA Code:
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
 
Upvote 0
How about
VBA Code:
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!
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top