VBA: Add and delete sheets from list

Question

I am working on a piece of code that creates a copy of a certain Template sheet or deletes a sheet based on the contents of a column in an Excel Sheet, starting in cell B2.

Actions I would like the Macro to do:

1) If a sheet name matches an array value do nothing
2) If there is no sheet for an array value, create a copy of the Template sheet and rename with the array value. Further, name cell A1 of the copied sheet as the array value.
3) If there is a sheet that does not exist in the array, delete the sheet. Except for the sheets named Input or Template.

Up to now I have two separate codes, one to copy sheets and the other to delete sheets:

Code in order to add sheets:

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomA As Integer
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
Dim c As Range
Dim ws As Worksheet
    For Each c In Range("A1:A" & bottomA)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            Sheets("Template").Select
            Sheets("Template").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.name = c.Value
        End If
    Next c
    Application.ScreenUpdating = True
    End Sub

Code in order to delete sheets:

Sub DeleteSheet()
Dim i As Long, x, wsAct As Worksheet
Set wsAct = ActiveSheet
For i = Sheets.Count To 1 Step -1
    If Not Sheets(i) Is wsAct Then
        x = Application.Match(Sheets(i).name, wsAct.Range("A1:A20"), 0)
        If IsError(x) Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
        End If
    End If
    Next i
    End Sub

My questions are:

1) How can I add the piece that renames cell A1 with the array value in the AddSheet code?

2) How can I add the except rules in the DeleteSheet code?

3) How can I combine these codes into one code and finally create a button to activate this macro in the Input sheet?

Many thanks in advance!

Answer 1

Here you go. The first thing you'll want to do is add Option Compare Text at the top of the module for use with the Like Operator. I must compliment you using Range("A" & Rows.Count).End(xlUp).Row That's my favorite method for finding max row. As a better practice, I recommend placing all Dim statements at the top of each Sub.

I chose to run through deletions first because the Employee List won't change during the procedure, but the number of worksheets it'll have to loop through can be reduced for the additions. Speed up where you can, right? The code below will grab Employee Names from Column B (excluding B1) from Input worksheet. I assigned Input and Template worksheet names as constants since they're used many times through the code. That way if you ever decide to call them something else, you're not hunting through code.

Even though the procedures are already merged here, we could have easily called another procedure from the 1st by placing DeleteSheet as the last line of AddSheet() This does not require the use of Call in the beginning. It was in the early days of Visual Basic but hasn't been for a long time now. Let me know if anything is unclear or not working as you like.

Sub CheckSheets()
    Dim wksInput As Worksheet
    Dim wks As Worksheet
    Dim cell As Range
    Dim MaxRow As Long
    Dim NotFound As Boolean
    Dim Removed As String
    Dim Added As String

    'Assign initial values
    Const InputName = "Input"
    Const TemplateName = "Template"
    Set wksInput = Worksheets(InputName)
    MaxRow = wksInput.Range("B" & Rows.Count).End(xlUp).Row

    Application.ScreenUpdating = False

    'Delete worksheets that don't match Employee Names or are not Input or Template
    For Each wks In Worksheets
        NotFound = True
        'Keep Input and Template worksheets safe
        If Not (wks.Name Like InputName Or wks.Name Like TemplateName) Then
            'Check all current Employee Names for matches
            For Each cell In wksInput.Range("B2:B" & MaxRow)
                If wks.Name Like cell Then
                    NotFound = False
                    Exit For
                End If
            Next cell
        Else
            NotFound = False
        End If
        'Match was not found, delete worksheet
        If NotFound Then
            'Build end message
            If LenB(Removed) = 0 Then
                Removed = "Worksheet '" & wks.Name & "'"
            Else
                Removed = Removed & " & '" & wks.Name & "'"
            End If
            'Delete worksheet
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
        End If
    Next wks

    'Check each Employee Name for existing worksheet, copy from template if not found
    For Each cell In wksInput.Range("B2:B" & MaxRow)
        NotFound = True
        For Each wks In Worksheets
            If wks.Name Like cell Then
                NotFound = False
                Exit For
            End If
        Next wks
        'Employee Name wasn't found, copy template
        If NotFound And LenB(Trim(cell & vbNullString)) <> 0 Then
            'Build end message
            If LenB(Added) = 0 Then
                Added = "Worksheet '" & cell & "'"
            Else
                Added = Added & " & '" & cell & "'"
            End If
            'Add the worksheet
            Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = cell
            ActiveSheet.Range("A1") = cell
        End If
    Next cell

    'Added here so user sees worksheets when the message displays
    Application.ScreenUpdating = True

    'Final message touchups and display to user
    If LenB(Removed) <> 0 And LenB(Added) <> 0 Then
        Removed = Removed & " has been removed from the workbook." & vbNewLine & vbNewLine
        Added = Added & " has been added to the workbook."
        MsgBox Removed & Added, vbOKOnly, "Success!"
    ElseIf LenB(Removed) <> 0 Then
        Removed = Removed & " has been removed from the workbook."
        MsgBox Removed, vbOKOnly, "Success!"
    ElseIf LenB(Added) <> 0 Then
        Added = Added & " has been added to the workbook."
        MsgBox Added, vbOKOnly, "Success!"
    End If
End Sub