Name already exists error when creating New worksheet based on table values-CodePudding

I have written a macro which expands a table based on a filled in value (which can be filled in manually). after that the second macro should copy a certain template (template worksheet) and change the name to the nr corresponding in the table. The first time it works since the sheets do not exist yet, however when expanding the table again and trying to add worksheets the error that the name already exists pops up. the macro should skip this error and move to the next "row", however I can not seem to manage this.

Table expansion macro:

Sub Tableexpension()

    'Declare Variables
    Dim oSheetName As Worksheet
    Dim sTableName As String
    Dim loTable As ListObject
    Dim loRows As Integer, loColumns As Integer
    Dim iNewRows As Integer, iNewColumns As Integer
    
    'Define Variable
    sTableName = "Table1"
    
    'Define WorkSheet object
    Set oSheetName = Sheets("Overview")
    
    'Define Table Object
    Set loTable = oSheetName.ListObjects(sTableName)
    
    'Find number of rows & columns in the table
    loRows = loTable.Range.Rows.Count
    loColumns = loTable.Range.Columns.Count

    'Specify Number of Rows & Columns to add to table
    iNewRows = Range("D3")
    
    'Resize the table
    loTable.Resize loTable.Range.Resize(loRows   iNewRows)
    
    'Number new table rows
    Dim tbl As ListObject
    Dim x As Long

    Set tbl = ActiveSheet.ListObjects("Table1")
    For x = 1 To tbl.ListRows.Count
        tbl.DataBodyRange(x, 1) = x
    Next x

End Sub

create worksheet macro:

Sub Create_worksheets()
    
    Dim rngCreateSheets As Range
    Dim oCell As Range
    Dim oTemplate As Worksheet
    Dim oSummary As Worksheet
    Dim oDest As Worksheet

    Set oTemplate = Worksheets("Template")
    Set oSummary = Worksheets("Overview")
    Set rngCreateSheets = Worksheets("Overview").Range("B6", Range("B6").End(xlDown))

    teller = 1
    For Each oCell In rngCreateSheets.Cells
        oTemplate.Copy After:=Worksheets(Sheets.Count)
        Set oDest = ActiveSheet
        oDest.Name = oCell.Value
        oDest.Range("C5").Value = oCell.Value
        oDest.Range("D2").Value = [start_scenario].Offset(teller, 0)
        oDest.Range("B3").Value = [start_scenario].Offset(teller, 1)
        oDest.Range("B4").Value = [start_scenario].Offset(teller, 2)
        oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _
            oDest.Name & "!C5", TextToDisplay:=oDest.Name
        teller = teller   1
    Next oCell
    
End Sub

I've tried to use some error codes, but just can't seem to manage to make it work.

CodePudding user response：

Something like this?

Sub Create_worksheets()

    Dim rngCreateSheets As Range
    Dim oCell As Range
    Dim oTemplate As Worksheet
    Dim oSummary As Worksheet
    Dim oDest As Worksheet
        
    Set oTemplate = Worksheets("Template")
    Set oSummary = Worksheets("Overview")
    Set rngCreateSheets = Worksheets("Overview").Range("B6", Range("B6").End(xlDown))
        
    teller = 1
        
    For Each oCell In rngCreateSheets.Cells
        If Not WorksheetExists(oCell.Value2) Then
            oTemplate.Copy After:=Worksheets(Sheets.Count)
            Set oDest = ActiveSheet
            oDest.Name = oCell.Value
            oDest.Range("C5").Value = oCell.Value
            oDest.Range("D2").Value = [start_scenario].Offset(teller, 0)
            oDest.Range("B3").Value = [start_scenario].Offset(teller, 1)
            oDest.Range("B4").Value = [start_scenario].Offset(teller, 2)
            oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _
            oDest.Name & "!C5", TextToDisplay:=oDest.Name
                        
            teller = teller   1 'Set this outside the If-check if the counter should continue even if you don't add a sheet
        End If
    Next oCell
End Sub

Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet

    If wb Is Nothing Then Set wb = ActiveWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    WorksheetExists = Not sht Is Nothing
End Function

You should try to avoid putting too much space between your code and add indentation for better readability. The function checks if the sheet exists and returns a FALSE if it doesn't exist yet, therefor you use If Not WorksheetExists(oCell.Value2) Then to only add the sheet then.

Hope this helps.

CodePudding user response：

add this function:

Function GetSheetOrCreateFromTemplate(ByVal shName As Long, templateSh As Worksheet) As Worksheet

    Dim sh As Worksheet
        On Error Resume Next
        
        Set sh = Worksheets(CStr(shName))
            Do While Not sh Is Nothing
                shName = shName   1
                
                Set sh = Nothing
                Set sh = Worksheets(CStr(shName))
            Loop
        
        On Error GoTo 0
    
            templateSh.Copy After:=Sheets(Sheets.Count)
            Set sh = ActiveSheet
            sh.Name = CStr(shName)
        
            Set GetSheetOrCreateFromTemplate = sh
            
End Function

and in Create_worksheets() change:

oTemplate.Copy After:=Worksheets(Sheets.Count)
Set oDest = ActiveSheet
oDest.Name = oCell.Value

to:

Set oDest = GetSheetOrCreateFromTemplate(oCell.Value, oTemplate)