Excel sheets from List

Question

I am trying to make an excel sheet where on the first sheet you have a list of names which you can add to, And when you add a name it makes a new sheet for that person, names the sheet their name, and the new sheet has a template already on it.

I am unsure if this is possible, I know I can use a module to make the sheets however I would have to click it each time and am making it for someone that doesn't really know that side to excel so want it to be user friendly for them.

So in a sense I want a list on the first page and a list of sheets at the bottom in order that is changing whenever someone adds a name to the list.

`Sub AddSheets()
'Updateby Extendoffice
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A2:A100")
        With wBk
            Application.CutCopyMode = False
            Sheets("MasterTemplate").Copy After:=Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet                     name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub`

I have used this and it makes the sheets as I wanted however It creates pages for blank cells and i don't know how to get it to do it once you hav added a new name

Answer 1

In the worksheet code module:

Option Explicit

Const RNG_ADDR As String = "A2:A100"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range, nm As String
    
    Set rng = Application.Intersect(Target, Me.Range(RNG_ADDR))
    If rng Is Nothing Then Exit Sub
    
    For Each c In rng.Cells
        nm = Trim(c.Value)
        If Len(nm) > 0 Then
            If Not SheetExists(nm) Then
                With ThisWorkbook
                    .Worksheets("MasterTemplate").Copy _
                        After:=.Worksheets(.Worksheets.count)
                    .Worksheets(.Worksheets.count).Name = nm
                End With
            Else
                MsgBox "The name '" & nm & "' is already in use"
            End If
        End If 'any name
    Next c
End Sub

Sub RemoveSelectedName()
    Const MSG As String = "First select a single name in range " & RNG_ADDR
    Dim c As Range, nm As String
    'in range of names?
    Set c = Application.Intersect(Selection, Me.Range(RNG_ADDR))
    
    If c Is Nothing Then
        MsgBox MSG
    ElseIf c.Cells.count > 1 Then
        MsgBox MSG
    Else
        nm = c.Value
        If Len(nm) = 0 Then
            MsgBox MSG
        Else
            On Error Resume Next
            ThisWorkbook.Worksheets(nm).Visible = False
            On Error GoTo 0
            c.ClearContents
        End If
    End If
End Sub


'Is there a worksheet named `SheetName` in workbook `wb`?
Function SheetExists(SheetName As String, Optional wb As Excel.Workbook) As Boolean
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    SheetExists = (wb.Sheets(SheetName).Name = SheetName)
End Function