• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help with VBA CODE ERROR

Jet Fusion

Member
Hi

Please can someone help, somewhere I've changed something now I keep getting an error code - Compile error - Sub or Function not defined

Code:
Sub AddNewWorksheet()
Const cstrTitle As String = "Add new worksheet"
Const cstrPrompt As String = "Give the name for the new worksheet." & vbCrLf & "Not allowed are the characters: : \ / ? * [ and ]"
Dim strInput As String
Dim strDefault As String: strDefault = ""
Dim strInputErrorMessage As String
Dim booValidatedOk As Boolean: booValidatedOk = False
    On Error GoTo HandleError
   
    Do
        strInput = InputBox(Prompt:=cstrPrompt, Title:=cstrTitle, Default:=strDefault)
        If Len(strInput) = 0 Then GoTo HandleExit
        GoSub ValidateInput
        If Not booValidatedOk Then
            If vbCancel = MsgBox(strInputErrorMessage & "Retry?", vbExclamation + vbOKCancel) Then GoTo HandleExit
        End If
    Loop While Not booValidatedOk
       
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim shts As Sheets: Set shts = wb.Sheets
    Dim obj As Object
    Set obj = shts.Add(Before:=ActiveSheet, Count:=1, Type:=XlSheetType.xlWorksheet)
    obj.Name = strInput
   
HandleExit:
    Exit Sub
HandleError:
    MsgBox Err.Description
    Resume HandleExit
   
ValidateInput:
    If SheetExists(strSheetName:=strInput) Then
        strInputErrorMessage = "Sheet already exists. "
    ElseIf Not IsValidSheetName(strSheetName:=strInput) Then
        strInputErrorMessage = "Sheetname not allowed. "
    Else
        booValidatedOk = True
    End If
    Return
End Sub


Thanks in advance
Jet
 
The line
If SheetExists(strSheetName:=strInput) Then

is looking for a function called SheetExists()
and also later it looks for IsValidSheetName()

So add the following code after the end of the existing Sub

Code:
Public Function SheetExists(strSheetName As String, Optional wbWorkbook As Workbook) As Boolean
    If wbWorkbook Is Nothing Then Set wbWorkbook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
    Dim obj As Object
    On Error GoTo HandleError
    Set obj = wbWorkbook.Sheets(strSheetName)
    SheetExists = True
    Exit Function
HandleError:
    SheetExists = False
End Function

Public Function IsValidSheetName(strSheetName As String) As Boolean
    IsValidSheetName = False
    If Len(strSheetName) = 0 Then Exit Function
    If Len(strSheetName) > ciMaxLenSheetName Then Exit Function

    Dim varSheetNameIllegalCharacters As Variant: varSheetNameIllegalCharacters = SheetNameIllegalCharacters
   
    Dim i As Integer
    For i = LBound(varSheetNameIllegalCharacters) To UBound(varSheetNameIllegalCharacters)
        If InStr(strSheetName, (varSheetNameIllegalCharacters(i))) > 0 Then Exit Function
    Next i

    IsValidSheetName = True
End Function

Private Function SheetNameIllegalCharacters() As Variant
    SheetNameIllegalCharacters = Array("/", "\", "[", "]", "*", "?", ":")
End Function

then also add the following line at the top of the code module

Code:
Private Const ciMaxLenSheetName As Integer = 31
 
o_O Did I paste it wrong, getting compile error - syntax error :rolleyes: lol I'm not very good with VBA


Code:
Sub AddNewWorksheet()
Private Const ciMaxLenSheetName As Integer = 31Const cstrTitle As String = "Add new worksheet"
Const cstrPrompt As String = "Give the name for the new worksheet." & vbCrLf & "Not allowed are the characters: : \ / ? * [ and ]"
Dim strInput As String
Dim strDefault As String: strDefault = "" 'setting initial value for inputbox can be useful
Dim strInputErrorMessage As String
Dim booValidatedOk As Boolean: booValidatedOk = False
    On Error GoTo HandleError
    
    Do
        strInput = InputBox(Prompt:=cstrPrompt, Title:=cstrTitle, Default:=strDefault)
        If Len(strInput) = 0 Then GoTo HandleExit
        GoSub ValidateInput
        If Not booValidatedOk Then
            If vbCancel = MsgBox(strInputErrorMessage & "Retry?", vbExclamation + vbOKCancel) Then GoTo HandleExit
        End If
    Loop While Not booValidatedOk
        
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim shts As Sheets: Set shts = wb.Sheets
    Dim obj As Object
    Set obj = shts.Add(Before:=ActiveSheet, Count:=1, Type:=XlSheetType.xlWorksheet)
    obj.Name = strInput
    
HandleExit:
    Exit Sub
HandleError:
    MsgBox Err.Description
    Resume HandleExit
    
ValidateInput:
    If SheetExists(strSheetName:=strInput) Then
        strInputErrorMessage = "Sheet already exists. "
    ElseIf Not IsValidSheetName(strSheetName:=strInput) Then
        strInputErrorMessage = "Sheetname not allowed. "
    Else
        booValidatedOk = True
    End If
    Return
End Sub

Public Function SheetExists(strSheetName As String, Optional wbWorkbook As Workbook) As Boolean
    If wbWorkbook Is Nothing Then Set wbWorkbook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
    Dim obj As Object
    On Error GoTo HandleError
    Set obj = wbWorkbook.Sheets(strSheetName)
    SheetExists = True
    Exit Function
HandleError:
    SheetExists = False
End Function

Public Function IsValidSheetName(strSheetName As String) As Boolean
    IsValidSheetName = False
    If Len(strSheetName) = 0 Then Exit Function
    If Len(strSheetName) > ciMaxLenSheetName Then Exit Function

    Dim varSheetNameIllegalCharacters As Variant: varSheetNameIllegalCharacters = SheetNameIllegalCharacters
  
    Dim i As Integer
    For i = LBound(varSheetNameIllegalCharacters) To UBound(varSheetNameIllegalCharacters)
        If InStr(strSheetName, (varSheetNameIllegalCharacters(i))) > 0 Then Exit Function
    Next i

    IsValidSheetName = True
End Function

Private Function SheetNameIllegalCharacters() As Variant
    SheetNameIllegalCharacters = Array("/", "\", "[", "]", "*", "?", ":")
End Function

:(
 
2 errors

see code below

Code:
Private Const ciMaxLenSheetName As Integer = 31

Sub AddNewWorksheet()
Const cstrTitle As String = "Add new worksheet"
Const cstrPrompt As String = "Give the name for the new worksheet." & vbCrLf & "Not allowed are the characters: : \ / ? * [ and ]"
Dim strInput As String
Dim strDefault As String: strDefault = "" 'setting initial value for inputbox can be useful
Dim strInputErrorMessage As String
Dim booValidatedOk As Boolean: booValidatedOk = False
    On Error GoTo HandleError
    
    Do
        strInput = InputBox(Prompt:=cstrPrompt, Title:=cstrTitle, Default:=strDefault)
        If Len(strInput) = 0 Then GoTo HandleExit
        GoSub ValidateInput
        If Not booValidatedOk Then
            If vbCancel = MsgBox(strInputErrorMessage & "Retry?", vbExclamation + vbOKCancel) Then GoTo HandleExit
        End If
    Loop While Not booValidatedOk
        
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim shts As Sheets: Set shts = wb.Sheets
    Dim obj As Object
    Set obj = shts.Add(Before:=ActiveSheet, Count:=1, Type:=XlSheetType.xlWorksheet)
    obj.Name = strInput
    
HandleExit:
    Exit Sub
HandleError:
    MsgBox Err.Description
    Resume HandleExit
    
ValidateInput:
    If SheetExists(strSheetName:=strInput) Then
        strInputErrorMessage = "Sheet already exists. "
    ElseIf Not IsValidSheetName(strSheetName:=strInput) Then
        strInputErrorMessage = "Sheetname not allowed. "
    Else
        booValidatedOk = True
    End If
    Return
End Sub

Public Function SheetExists(strSheetName As String, Optional wbWorkbook As Workbook) As Boolean
    If wbWorkbook Is Nothing Then Set wbWorkbook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
    Dim obj As Object
    On Error GoTo HandleError
    Set obj = wbWorkbook.Sheets(strSheetName)
    SheetExists = True
    Exit Function
HandleError:
    SheetExists = False
End Function

Public Function IsValidSheetName(strSheetName As String) As Boolean
    IsValidSheetName = False
    If Len(strSheetName) = 0 Then Exit Function
    If Len(strSheetName) > ciMaxLenSheetName Then Exit Function

    Dim varSheetNameIllegalCharacters As Variant: varSheetNameIllegalCharacters = SheetNameIllegalCharacters
  
    Dim i As Integer
    For i = LBound(varSheetNameIllegalCharacters) To UBound(varSheetNameIllegalCharacters)
        If InStr(strSheetName, (varSheetNameIllegalCharacters(i))) > 0 Then Exit Function
    Next i

    IsValidSheetName = True
End Function

Private Function SheetNameIllegalCharacters() As Variant
    SheetNameIllegalCharacters = Array("/", "\", "[", "]", "*", "?", ":")
End Function
 
Hi @Hui ,

I have tried the code and it works for the 1st bit except it is not copying the sheet that I would like it to copy. I have this written but have no idea where to put it in your above code.

Code:
Worksheets("Sheet 1").Copy Before:=Sheets(Worksheets.Count)

Would it also be possible to change your code so that the new sheet it copies goes to infront of the current active tab?

Thanks in advance
Jet
 
Back
Top