Automatically creating worksheets based on a list in excel - vba

Question

I am trying to achieve the following.
When I enter a value on 'Master' worksheet in the Range A5:A50, a macro is run which creates a new worksheet with the same name as the value and then copies the template onto the new sheet.
In addition to this I would also like to copy the value adjacent to the value enter on Master worksheet to this new worksheet so it does calculations automatically.
For example I enter '1' in A5 and '2' in B5. I would like to create a new worksheet with name '1', copy the template from 'Template' worksheet and copy the value of B5 on to the new worksheet named '1'.
I have following code but it also tries to copy Template worksheet with macro is run which results in an error because a worksheet with name 'Template' already exists.
Sub CreateAndNameWorksheets()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Sheets("Master").Range("A5:A50")
Sheets("Template").Copy After:=Sheets(Sheets.Count)
With c
ActiveSheet.Name = .Value
.Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
"'" & .Text & "'!A1", TextToDisplay:=.Text
End With
Next c
Application.ScreenUpdating = True
End Sub

Answer 1

Right-click the Master worksheet's name tab and select View Code. When the VBE opens up, paste the following into the window titled something like Book1 - Master (Code).
Private Sub Worksheet_Change(ByVal target As Range)
If Not Intersect(target, Rows("5:50"), Columns("A:B")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim r As Long, rw As Long, w As Long
For r = 1 To Intersect(target, Rows("5:50"), Columns("A:B")).Rows.Count
rw = Intersect(target, Rows("5:50"), Columns("A:B")).Rows(r).Row
If Application.CountA(Cells(rw, 1).Resize(1, 2)) = 2 Then
For w = 1 To Worksheets.Count
If LCase(Worksheets(w).Name) = LCase(Cells(rw, 1).Value2) Then Exit For
Next w
If w > Worksheets.Count Then
Worksheets("Template").Visible = True
Worksheets("Template").Copy after:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = Cells(rw, 1).Value2
.Cells(1, 1) = Cells(rw, 2).Value
End With
End If
With Cells(rw, 1)
.Parent.Hyperlinks.Add Anchor:=Cells(rw, 1), Address:="", _
SubAddress:="'" & .Value2 & "'!A1", TextToDisplay:=.Value2
End With
End If
Next r
Me.Activate
End If
bm_Safe_Exit:
Worksheets("Template").Visible = xlVeryHidden
Me.Activate
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Note that this depends on you having a worksheet named Template in order to generate the new worksheets. It also keeps the Template worksheet xlVeryHidden which means that it will not show up if you try to unhide it. Go into the VBE and use the Properties window (e.g. F4) to set the visibility to visible.
This routine should survive pasting multiple values into A2:B50 but it will discard proposed worksheet names in column A that already exists. There must be a value i both column A and column B of any row before it will proceed.
There are currently no checks for illegal worksheet name characters. You may want to familiarize yourself with those and add some error checking.

Answer 2

Another example relevant to the post title but not the specific application. Code updates sheets in master list with list row number creating sheet from template if it doesn't exist.
Other reference: https://stackoverflow.com/a/18411820/9410024.
Sub UpdateTemplateSheets()
' Update sheets in list created from a template
'
' Input: List on master sheet, template sheet
' Output: Updated sheet from template for each item in list
'
Dim wsInitial As Worksheet
Dim wsMaster As Worksheet
Dim wsTemp As Worksheet
Dim lVisibility As XlSheetVisibility
Dim strSheetName As String
Dim rIndex As Long
Dim i As Long
On Error GoTo Safe_Exit
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
' Application.Calculation = xlCalculationManual
Set wsInitial = ActiveSheet
Set wsMaster = Sheets("Summary")
Set wsTemp = Sheets("Template")
lVisibility = wsTemp.Visible ' In case template sheet is hidden
wsTemp.Visible = xlSheetVisible
For rIndex = 2 To wsMaster.Cells(Rows.Count, "A").End(xlUp).Row
' Ensure valid sheet name
strSheetName = wsMaster.Cells(rIndex, "A").Text
For i = 1 To 7
strSheetName = Replace(strSheetName, Mid(":\/?*[]", i, 1), " ")
Next i
strSheetName = Trim(Left(WorksheetFunction.Trim(strSheetName), 31))
' Ensure sheet name doesn't already exist
If Not Evaluate("IsRef('" & strSheetName & "'!A1)") Then
wsTemp.Copy after:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = strSheetName
End With
End If
With Sheets(strSheetName)
.Range("B59").Value = rIndex * 16 + 1 ' Update template block option row
End With
Next rIndex
Safe_Exit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
'Application.Calculation = xlCalculationAutomatic
wsInitial.Activate
wsTemp.Visible = lVisibility ' Set template sheet to its original visible state
End Sub