Compile Error: Sub or Function not defined

[Fieldsdj]

Hello,

Thanks to this forum I was able to get some working code to copy a template worksheet and rename them according to a list of names in a range. So, I changed my project a little and instead of a range I just want to use one cell. I thought I could adjust my code but for some reason it's not working.

Sub Button1_Click()
 Dim numrows As Long, i As Long
 Dim sname As String
 With Sheet2
 numrows = WorksheetFunction.CountA(.Range("B7"))
 If numrows = 0 Then Exit Sub
 For i = 1 To numrows
 If Contains(Sheets, .Cells(i + 6, "B").Value) Then
 sname = .Cells(i + 6, "B").Value
 Call MsgBox(sname & " Sheet name already exists. Remove from List and try again", vbCritical, Application.Name)
Exit Sub
End If
ThisWorkbook.Sheet3.Copy After:=Sheets(Sheets.Count)
 ThisWorkbook.Sheets(Sheets.Count).Name = .Cells(i + 6, "B").Value
 Next
 End With
 End Sub<strike></strike>

So the sheet I want to copy is Sheet3 and what I want the name to be changed to will be in cell B7. I'm getting the error at the "If Contains" line. Thanks for anyone that can help me out.

 

[MARK858]

When I put an invalid character in the name for some reason it gives a run time error '1004' and highlights the line..... Any ideas why?

Surely you have answered that yourself



Edit: It also might be worth you reading the link below especially as Trebor76 has already suggested using the sheets codename.

http://www.ozgrid.com/VBA/excel-vba-sheet-names.htm

 

[Trebor76]

Thanks Mark I was just about to direct Fieldsdl to the page

Fieldsdl - What is the invalid character? I thought I had captured them all in the 'varInvalidChars' array If not just add the character(s) there and to the associated custom error message.

 

[Fieldsdj]

Surely you have answered that yourself



Edit: It also might be worth you reading the link below especially as Trebor76 has already suggested using the sheets codename.

Sheet CodeNames: Reference Sheets in Excel Workbooks by Code Name

Thank you for the link, I understand that now. I was asking why the invalid character error still happened because there was code to pop up a message box and let the user know they needed to change it. It isn't working and I can't figure out why.

 

[Fieldsdj]

Thanks Mark I was just about to direct Fieldsdl to the page

Fieldsdl - What is the invalid character? I thought I had captured them all in the 'varInvalidChars' array If not just add the character(s) there and to the associated custom error message.

It was the / character, which is in the array so it should work. Confusing...

 

[Trebor76]

Try this:

Option Explicit
Sub Button1_Click()

    Dim numrows As Long, i As Long
    Dim sname As String
    Dim objMySheet As Object
    Dim varInvalidChars As Variant
    Dim lngCellPos As Long
    
    varInvalidChars = Array(":", "\", "/", "?", "*", "[", "]")
    
    With ThisWorkbook.Sheets("Sheet2") 'Sheet name for the main sheet. Change to suit if necessary
        numrows = WorksheetFunction.CountA(.Range("B7"))
        If numrows = 0 Then Exit Sub
        For i = 1 To numrows
            'Check for invalid characters within the propsed name
            For lngCellPos = 1 To Len(.Cells(i + 6, "B").Value)
                If IsNumeric(Application.Match(Mid(.Cells(i + 6, "B").Value, lngCellPos, 1), varInvalidChars, 0)) = True Then
                    MsgBox "The proposed sheet name in cell B" & i + 6 & " contains one or more invalid characters." & vbNewLine & "Remove any invalid characters: : \ / ? * [ or ] and try again.", vbCritical
                    Exit Sub
                End If
            Next lngCellPos
            'Propsed sheet name validation
            If Len(.Cells(i + 6, "B").Value) = 0 Then
                MsgBox "There is no proposed name in cell B" & i + 6 & "." & vbNewLine & "Ensure all cells are filled in and try again.", vbCritical
                Exit Sub
            ElseIf Len(.Cells(i + 6, "B").Value) > 31 Then
                MsgBox "The proposed sheet name in cell B" & i + 6 & " has more then 31 characters." & vbNewLine & "Ensure all cells have a maximum of 31 characters and try again.", vbCritical
                Exit Sub
            ElseIf StrConv(.Cells(i + 6, "B").Value, vbProperCase) = "History" Then
                MsgBox "A tab cannot be named ""History"" as it is a reseved name." & vbNewLine & "Change the name in cell B" & i + 6 & " and try again.", vbCritical
                Exit Sub
            Else
                'If the proposed name in cell B[i+6] already exists the in workbook, then...
                On Error Resume Next 'Stop run-time error 9 error message if the tab doesn't exist
                    Set objMySheet = Sheets(.Cells(i + 6, "B").Value)
                    If Err.Number = 0 Then
                        '...put that name to the 'sname' variable and alert the user that it already exists and quit the routine.
                        sname = .Cells(i + 6, "B").Value
                        MsgBox "There is already a sheet called """ & sname & """ in the workbook." & vbNewLine & "Remove or change the entry in cell B" & i + 6 & " and try again.", vbCritical
                        Exit Sub
                    End If
                On Error GoTo 0
            End If
            'If the code gets here copy the template sheet (set here as 'Sheet3' change to suit if necessary) to the end of this workbook and name it via the text in cell B[i+6]
            ThisWorkbook.Sheets("Sheet3").Copy After:=Sheets(Sheets.Count)
            ThisWorkbook.Sheets(Sheets.Count).Name = .Cells(i + 6, "B").Value
        Next i
    End With
    
    Set objMySheet = Nothing
 
End Sub

You need to check each individual character - I was just checking the cell entry as a whole. I had also put + 10 to test the code which should have been removed for go-live

Robert

 

[Fieldsdj]

Robert,

The code works like a champ! Again, thank you so much for your time helping me with this. This website and the people like you that help everyone are invaluable.

 

[Trebor76]

Thanks for letting us know it's solved and the kind words. I'm glad we could all help to get you a suitable solution