VBA Creating Sheets, error handeling - vba

Question

I am using the code below, to copy a hidden worksheet and copy it, rename is and fill in certain fields on two sheets.
I have done it like this, as i need to copy the layout and formatting of the hidden sheet.
The problem I am having, is that when i click the create button, if the sheet already exits, it completely crashes Excel, I have tried to add error handling but everything i have tried to check if the sheet exists doesn't work and still crashes Excel.
Have have separated the code that is un-hides the template sheet, copys it, renames the new sheet, and then re-hides the template.
What I would like it to do, is check the entered sheet name from TextBox5, and check is the sheet exists, if it does the display a message box, saying sheet already exists, if the sheet does not exist them carry on with the code as normal.
If really appreciate all the help and support i have already received, and thank all of you for the help you can provide with this.
Private Sub CommandButton3_Click()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Template")
Dim newws As Worksheet, sh As Worksheet, newname
Dim query As Long, xst As Boolean, info As String
Dim NextRow As Long, myCCName As Variant, lastRow2 As Long, lastRow As Long
'Contract Name
Dim Contact As String, name As String, name2 As String, SpacePos As Integer
Dim answer As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
lastRow2 = Sheets("Payment Form").Range("A18:A34").End(xlDown).Row
lastRow = Sheets("Payment Form").Range("U36:U53").End(xlDown).Row
'Contract Name
Set contract = Sheets("Payment Form").Range("C9")
SpacePos = InStr(contract, "- ")
name = Left(contract, SpacePos)
name2 = Right(contract, Len(contract) - Len(name))
'
retry:
xst = False
newname = Me.TextBox5.Value
myCCName = Me.TextBox4.Value
If newname = "" Then
MsgBox "You have not entered a CC Code Number. Please enter CC Code Number!", vbExclamation, "An Error Occured"
Exit Sub
End If
If myCCName = "" Then
MsgBox "You have not entered a CC Code Name. Please enter CC Code Name!", vbExclamation, "An Error Occured"
Exit Sub
End If
For Each sh In wb.Sheets
If sh.name = newname Then
xst = True: Exit For
End If
Next
If Len(newname) = 0 Or xst = True Then
info = "Sheet name is invalid. Please retry."
GoTo retry
End If
Sheets("Template").Visible = True
ws.Copy before:=Sheets("Details"): Set newws = ActiveSheet: newws.name = newname
Sheets("Template").Visible = False
With ActiveWorkbook.Sheets("Payment Form").Activate
For Each cell In Columns(1).Range("A18:A34").Cells
If Len(cell) = 0 Then cell.Select: Exit For
Next cell
ActiveCell.Value = newname & " " & "-" & name2 & ":" & " " & myCCName
End With
With ActiveWorkbook.Sheets(newname).Activate
ActiveWorkbook.Sheets(newname).Range("D4") = Sheets("Payment Form").Range("a18:a34").End(xlDown).Value
ActiveWorkbook.Sheets(newname).Range("D6") = Sheets("Payment Form").Range("L11").Value
ActiveWorkbook.Sheets(newname).Range("D8") = Sheets("Payment Form").Range("C9").Value
ActiveWorkbook.Sheets(newname).Range("D10") = Sheets("Payment Form").Range("C11").Value
End With
ActiveWorkbook.Sheets("Payment Form").Activate
With ActiveWorkbook.Sheets("Payment Form")
Range("J" & lastRow2 + 1) = 0
Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & ""
Range("N" & lastRow2 + 1).Formula = "='" & newname & "'!L20"
Range("U" & lastRow + 1) = newname & ":" & " "
Range("V" & lastRow + 1).Formula = "='" & newname & "'!I21"
Range("W" & lastRow + 1).Formula = "='" & newname & "'!L23"
Range("X" & lastRow + 1).Formula = "='" & newname & "'!K21"
End With
answer = MsgBox("Would you like to create another sheet?", vbYesNo + vbQuestion, "New Sheet")
If answer = vbYes Then
Else
Unload Me
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
End Sub

Answer 1

There appear to be a few general typos and a few errors with your 'With' statements throughout the code.
I have hopefully tidied up and recoded the function to work, but as it is untested I can't guarantee it will work off the bat.
I have also included the worksheet check function as a separate function
Private Sub CommandButton3_Click()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsTemplate As Worksheet: Set wsTemplate = wb.Sheets("Template")
Dim wsPayment As Worksheet: Set wsPayment = wb.Sheets("Payment Form")
Dim wsNew As Worksheet
Dim NewName As String: NewName = Me.TextBox5.Value
Dim CCName As Variant: CCName = Me.TextBox4.Value
If NewName = "" Or CCName = "" Then
MsgBox "CC Code Name or Number missing. Please check details!", vbExclamation, "An Error Occured"
Exit Sub
End If
If WorksheetExists(NewName) Then
MsgBox "Sheet name already exists. Please retry!", vbExclamation, "An Error Occured"
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
Dim lastRow As Long: lastRow = wsPayment.Range("U36:U53").End(xlDown).Row
Dim lastRow2 As Long: lastRow2 = wsPayment.Range("A18:A34").End(xlDown).Row
'Contract Name
Dim Contract As String: Contract = Sheets("Payment Form").Range("C9").Value
Dim SpacePos As Integer: SpacePos = InStr(Contract, "- ")
Dim Name As String: Name = Left(Contract, SpacePos)
Dim Name2 As String: Name2 = Right(Contract, Len(Contract) - Len(Name))
wsTemplate.Visible = True
wsTemplate.Copy before:=Sheets("Details"): Set wsNew = ActiveSheet
wsTemplate.Visible = False
With wsPayment
For Each Cell In .Range("A18:A34")
If Len(Cell) = 0 Then
Cell.Value = NewName & " -" & Name2 & ": " & CCName
Exit For
End If
Next Cell
End With
With wsNew
.Name = NewName
.Range("D4").Value = wsPayment.Range("A18:A34").End(xlDown).Value
.Range("D6").Value = wsPayment.Range("L11").Value
.Range("D8").Value = wsPayment.Range("C9").Value
.Range("D10").Value = wsPayment.Range("C11").Value
End With
With wsPayment
.Range("J" & lastRow2 + 1).Value = 0
.Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & ""
.Range("N" & lastRow2 + 1).Formula = "='" & NewName & "'!L20"
.Range("U" & lastRow + 1).Value = NewName & ": "
.Range("V" & lastRow + 1).Formula = "='" & NewName & "'!I21"
.Range("W" & lastRow + 1).Formula = "='" & NewName & "'!L23"
.Range("X" & lastRow + 1).Formula = "='" & NewName & "'!K21"
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
Dim Answer As Integer: Answer = MsgBox("Would you like to create another sheet?", _
vbYesNo + vbQuestion, "New Sheet")
If Answer = vbNo Then Unload Me
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function

Answer 2

Personally i use the function below to check if a sheet allready exist in the workbook, in which case it returns True:
Public Function doItExist(strSheetName as String) As Boolean
Dim wsTest As Worksheet: Set wsTest = Nothing
On Error Resume Next
Set wsTest = ThisWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
doExist = False
Else
doExist = True
End If
End Function
I cannot seem to find the original source for the code, but I cannot take credit, it is mearly a modified version of some code I found on either SO, ozgrid or Mrexcel
EDIT:
Taking a closer look at your code, it seems you allready check for the existence of the sheetname in the xst variable. As far as I can see the user is not able to update the sheetname if is invalid, as the retry block will just keep looping?
under retry:
'### This bit essentially does the same as doSheetExist
For Each sh In wb.Sheets
If sh.name = newname Then
xst = True: Exit For
End If
Next
'###
If Len(newname) = 0 Or xst = True Then 'if you go for the doSheetExist, then the xst check is obsolete. Else move the xst check to the elseif and remove the doSheetExist call
info = "Sheet name is invalid. Please retry."
'GoTo retry 'As far as I can tell calling retry would just cause an infinite loop as the user have had no chance to update sheetname
Exit Sub 'let the user update and click the button again
ElseIf doSheetExist(newname) = True Then
info = "Sheet name allready exist. Please specify other sheetname"
Exit Sub
End If