Creating new sheet with user input

[deanw55]

Hi,
I have a workbook with lots of existing sheets which is manipulated by many users. The first sheet is called Lookup and on this sheet the user enters data in 2 cells (D3 = ID of the location and D4 = name of the location). The script then checks if a sheet with that same name (D4) exists and creates a new sheet with that name or rejectes the creation. But I'm getting into trouble because users may use different names for the same location (abbreviations and so on) so I want to be sure, that no sheet with that name exists AND no other sheet includes that location ID (which is unique for every location). This location ID stands in every existing sheet in the cell N3. Could you please help me out? Thank you in advance. I would like to:
1. Unhide the sheet named Template (that sheet serves as a template for new sheets)
1. Check if the users entered something in D4
2. Warn the user if the cell is empty (msgbox) else proceed
3. Check the workbook for existing sheets with the name given in D4
4. If a sheet with that name exists then warn the user (msgbox) and exit sub else proceed
5. If a sheet with this name doesn't exist check the location ID given in D3 in all existing sheets in cell N3
6. Warn the user if a sheet already contains that location ID (msgbox) and exit sub or create the new sheet with that name given in D4
7. Copy values from the Lookup sheet cells D3 and D4 and copy them into the newly created sheet into cells N3 and N4

Below is the code I'm using right now and it's working smooth - just missing that part with the location ID check. Thank you all for your help.

Sub CreateNewSheet()

    Application.ScreenUpdating = False
    Sheets("TEMPLATE").Visible = True
    Set Template = Sheets("TEMPLATE")
    Set Lookup = Sheets("Lookup")
    Dim myNewSheetName As String
    Dim myNewSheetID As String
    myNewSheetName = Lookup.Range("D4").Value
    myNewSheetID = Lookup.Range("D3").Value

If myNewSheetName = "" Then
   MsgBox "Sheet name cannot be blank"
   Sheets("TEMPLATE").Visible = False
   Exit Sub
ElseIf Evaluate("isref('" & myNewSheetName & "'!D4)") Then
   MsgBox myNewSheetName & " is already taken"
   Sheets(myNewSheetName).Activate
   Sheets("TEMPLATE").Visible = False
   Exit Sub
End If
Template.Copy , Sheets("Template")
Sheets("TEMPLATE").Visible = False
ActiveSheet.Name = myNewSheetName

Lookup.Select
Range("D3:D4").Copy
Sheets(myNewSheetName).Activate
Range("N2").PasteSpecial xlPasteValues
Call LookupIp
Application.ScreenUpdating = True

End Sub

 

[dmt32]

Hi,
see if this update to your code does what you want

Sub CreateNewSheet()
    Dim wsTemplate      As Worksheet, ws As Worksheet
    Dim myNewSheetName  As String
    Dim myNewSheetID    As String
   
    With ThisWorkbook
        Set Lookup = .Worksheets("Lookup")
        Set wsTemplate = .Worksheets("TEMPLATE")
    End With
   
    myNewSheetName = Lookup.Range("D4").Value
    myNewSheetID = Lookup.Range("D3").Value
   
    If myNewSheetName = "" Then
        'check blank entry
        MsgBox "Sheet name cannot be blank", 16, "Sheet Name Required"
       
    ElseIf Evaluate("isref('" & myNewSheetName & "'!D4)") Then
        'check existing sheet name
        MsgBox myNewSheetName & " Is already taken", 48, "Sheet Exists"
        Worksheets(myNewSheetName).Activate
       
    Else
        'check existing ID
        For Each ws In ThisWorkbook.Worksheets
            If ws.Range("N3").Value = myNewSheetID Then
                MsgBox "Location ID " & myNewSheetID & Chr(10) & _
                "Already Exists In Sheet " & ws.Name, 16, "ID Exists"
                Exit Sub
            End If
        Next ws
       
    Application.ScreenUpdating = False
   
        With wsTemplate
            .Visible = True
            .Copy , wsTemplate
            .Visible = False
        End With
       
        ActiveSheet.Name = myNewSheetName
       
        Lookup.Range("D3:D4").Copy
        Worksheets(myNewSheetName).Range("N2").PasteSpecial xlPasteValues
        Call LookupIp
       
    End If
   
    With Application
        .CutCopyMode = False: .ScreenUpdating = True
    End With
   
End Sub

Dave

 

[deanw55]

Exactly! Thank you so much.
BR, Dean

 

[dmt32]

most welcome & appreciate your feedback

Dave

 

[deanw55]

Hi,
I did some tests now. It's sadly not working as supposed. When I enter a already taken ID in the cell D3 and a new location name in D4 it creates a new sheet with the new name and the ID which exists in another sheet. Is it maybe the part below 'check existing ID at the if statement (ws.Range only?). Should there maybe be defined which worksheet (ws)?

            If ws.Range("N3").Value = myNewSheetID Then

Sub CreateNewSheet()
    Dim wsTemplate      As Worksheet, ws As Worksheet
    Dim myNewSheetName  As String
    Dim myNewSheetID    As String
   
    With ThisWorkbook
        Set Lookup = .Worksheets("Lookup")
        Set wsTemplate = .Worksheets("TEMPLATE")
    End With
   
    myNewSheetName = Lookup.Range("D4").Value
    myNewSheetID = Lookup.Range("D3").Value
   
    If myNewSheetName = "" Then
        'check blank entry
        MsgBox "Sheet name cannot be blank", 16, "Sheet Name Required"
       
    ElseIf Evaluate("isref('" & myNewSheetName & "'!D4)") Then
        'check existing sheet name
        MsgBox myNewSheetName & " Is already taken", 48, "Sheet Exists"
        Worksheets(myNewSheetName).Activate
       
    Else
        'check existing ID
        For Each ws In ThisWorkbook.Worksheets
            If ws.Range("N3").Value = myNewSheetID Then
                MsgBox "Location ID " & myNewSheetID & Chr(10) & _
                "Already Exists In Sheet " & ws.Name, 16, "ID Exists"
                Exit Sub
            End If
        Next ws
       
    Application.ScreenUpdating = False
   
        With wsTemplate
            .Visible = True
            .Copy , wsTemplate
            .Visible = False
        End With
       
        ActiveSheet.Name = myNewSheetName
       
        Lookup.Range("D3:D4").Copy
        Worksheets(myNewSheetName).Range("N2").PasteSpecial xlPasteValues
        Call LookupIp
       
    End If
   
    With Application
        .CutCopyMode = False: .ScreenUpdating = True
    End With
   
End Sub

 

[dmt32]

Is the ID numeric, Alpha or Alpha Numeric?

Dave

 

[deanw55]

Is the ID numeric, Alpha or Alpha Numeric?

Dave

The ID is a classic number, so numeric value.

 

[dmt32]

with that scenario it seems to work ok for me - have you made any changes to the code?

 

[deanw55]

with that scenario it seems to work ok for me - have you made any changes to the code?

View attachment 72996

Sorry, I've been testing with one of the sheets with a dislocated cell N3 which was to lookup for the existing name. The code is working perfectly. Thank you!

 

[dmt32]

no worries glad resolved & appreciate feedback

Dave