0

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.

6
  • and what should happen if the sheet is already there? Commented Jan 3, 2023 at 9:51
  • it should not add that sheet and move to the next. for example if sheet 1 already exists but 2 not, it should not create a second sheet 1 and it should create a sheet 2. Commented Jan 3, 2023 at 9:57
  • what should "sheet2" be named after, then? Commented Jan 3, 2023 at 10:00
  • i create a table which just numbers 1,2,3 etc. so sheet 2 should be named 2 sheet 3 should be named 3 etc. Commented Jan 3, 2023 at 10:05
  • yes, and what should happen if sheet "2" is already there? Commented Jan 3, 2023 at 10:06

2 Answers 2

0

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.

Sign up to request clarification or add additional context in comments.

4 Comments

This works almost perfect, thanks! however when i do this, the new sheet has the same name as row nr 1 in the table. is it possible to link this so that when I fill in the title in the table it directly changes the title (D2) in the corresponding sheet?
You could use a Private Sub Worksheet_Change(ByVal Target As Range) for automaticly changing the sheetname when changing the table (this belongs in the sheet's code page (Overview). You can check this one as an example: stackoverflow.com/questions/54672980/…
However, changing the sheets this way isn't advised since you could add rows in between but then the order of names vs the order in which the sheets are added isn't 1 on 1 anymore. If you could have a helper column for when you want to change sheet names, then that's far more feasible. With 1 column being old names and the other new names.
I've solved it through a lookup function in the template. this is sufficient and works perfect for what I want to use it. Thanks for helping!
0

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) 

1 Comment

@Mycha-van-Rossun, did you try this solution?

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.