Adding new Timesheet from a list

I am using the code below (Excel 2007) to delete and add back timesheets based on a list of names from the “Names” tab. In addition, I am making a “Table of Contents” with hyperlinks on a separate worksheet that will allow employees quick access to their timesheet without having to look at each tab. The code below works well if I want to delete and add back all the timesheet at one time but if we get a new employee in the middle of a pay period I have to use a single timesheet until the end of the pay period.

What I would like to know is, can the code below be modified so that when the code is run it reviews the list of names and only adds a new timesheet for that employee without deleting and adding back all the timesheets?

Sub CreateSheetsFromAList1()
Dim ws1 As Worksheet
Dim MyCell As Range, myRange As Range
'Only to be used to create tabs based on Names
Application.DisplayAlerts = False

For Each ws1 In ThisWorkbook.Worksheets
    If ws1.Name <> "Master" And ws1.Name <> "Table of Contents" And ws1.Name <> "Names" And ws1.Name <> "Lookup" Then ws1.Delete
Next ws1
    
    Set ws1 = ThisWorkbook.Worksheets("Master")
Worksheets("Names").Visible = xlSheetVisible
Worksheets("Master").Visible = xlSheetVisible

Sheets("Master").Select
'Call Macro5
    
    Set myRange = Sheets("Names").Range("B2")
    Set myRange = Range(myRange, myRange.End(xlDown))
On Error GoTo ErrHandler
    For Each MyCell In myRange
       ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
       ThisWorkbook.Worksheets("Master (2)").Name = MyCell.Value
    
    
    Next MyCell


ErrHandler: Call DelSht
Call CreateTableOfContents
Application.DisplayAlerts = True
Worksheets("Names").Visible = xlSheetHidden
Worksheets("Master").Visible = xlSheetHidden
Sheets("Table of Contents").Range("A2").Select
End Sub

Hi OAM,

See the attached workbook (written and tested in Excel 2003) based on your original code. It has macros to:
a. Make the 'Names' Sheet visible (needed for testing).
b. Delete all TimeSheets and add TimeSheets based on the 'Names' Sheet (existing capability). This also adds the capability of checking for 'duplicate names' on the 'Names' Sheet.
c. Add TimeSheets from the 'Names' Sheet only if the TimeSheet does NOT exist.
d. Sort the TimeSheets in ascending order.

Please note that I created stub routines for 'DelSht() (I don't know what this is supposed to do) and 'CreateTableOfContents()'.

There are command buttons on the 'Names' Sheet for items b. thru d. above.

Lewis

The code follows:

ption Explicit

Sub aaaaMakeNamesVisible()
  'This makes Sheet 'Names' visible and sets the focus on the 'Names' Sheet

  Const sSheetName = "Names"
  If LjmSheetExists(sSheetName) Then
    ThisWorkbook.Sheets(sSheetName).Visible = True
  End If
  
  ThisWorkbook.Activate
  Sheets(sSheetName).Select
  Range("A1").Select
End Sub

Sub DeleteAllEmployeesThenAddAllEmployees()
  Call CreateSheetsFromAList("DELETE THEN ADD")
End Sub

Sub AddNewEmployees()
  Call CreateSheetsFromAList("NO DELETE")
End Sub


Sub CreateSheetsFromAList(sOption As String)
  'This Adds Timesheets to the Workbook
  '
  'When the Input Option 'sOption' is "NO DELETE" then
  'Timesheets (that don't already exist) are added from the list on the 'Names' Sheet.
  '
  'When the Input Option is anything else then
  'a. All existing timesheets are deleted
  'b. Timesheets are added from the list on the 'Names' Sheet.
  'c. A check is made for duplicate names

  Dim ws1 As Worksheet
  
  Dim MyCell As Range
  Dim myRange As Range
  
  Dim iDeleteCount As Integer
  Dim iAddCount As Integer
  
  Dim bNeedDelete As Boolean
  
  Dim sNewSheetName As String
  Dim sSheetName As String
  
  'Only to be used to create tabs based on Names
  Application.DisplayAlerts = False
  
  If Trim(UCase(sOption)) <> "NO DELETE" Then
    bNeedDelete = True
  End If
 
  'Delete Existing TimeSheets (if DELETE) is allowed
  If bNeedDelete = True Then
     For Each ws1 In ThisWorkbook.Worksheets
      sSheetName = Trim(ws1.Name)
    
      Select Case sSheetName
    
        Case "Master"
          'do nothing - Not a TimeSheet
        
        Case "Table Of Contents"
          'do nothing - Not a TimeSheet
        
        Case "Names"
          'do nothing - Not a TimeSheet
        
        Case "Lookup"
          'do nothing - Not a TimeSheet
        
        Case Else
          'TimeSheet - Delete this sheet
          iDeleteCount = iDeleteCount + 1
          ws1.Delete
      End Select
    Next ws1
  End If
  
  
  Set ws1 = ThisWorkbook.Worksheets("Master")
  Worksheets("Names").Visible = xlSheetVisible
  Worksheets("Master").Visible = xlSheetVisible

  Sheets("Master").Select
  'Call Macro5
    
  'Set the range that contains the names
  Set myRange = Sheets("Names").Range("B2")
  Set myRange = Range(myRange, myRange.End(xlDown))
  On Error GoTo ErrHandler
  
  'Add sheets for all Employees
  For Each MyCell In myRange
  
    'Get the New Sheet Name
     sNewSheetName = Trim(MyCell.Text)
  
     If LjmSheetExists(sNewSheetName) Then
       If bNeedDelete = True Then
         'Report duplicate names only if 'Deleting and Adding'
         MsgBox "Duplicate Name '" & sNewSheetName & "' in Sheet 'Names' Cell '" & MyCell.Address(False, False) & "'." & vbCrLf & _
                "Duplicate Name being ignored."
       End If
     Else
    
       iAddCount = iAddCount + 1

       'Make a copy of the 'Master' Sheet (and put it after the last existing sheet)
       ws1.Copy After:=ThisWorkbook.Sheets(Sheets.Count)
     
       'Clear the Clipboard buffer
       Application.CutCopyMode = False

       'The New sheet is now the Active sheet
       'Rename the sheet after removing leading and trailing White Space
       ActiveSheet.Name = sNewSheetName
     End If
     
  Next MyCell


ErrHandler:
  Call DelSht       '?????? Don't know what this does and if it affects when User(s) are Added
  Call CreateTableOfContents
  Application.DisplayAlerts = True
  Worksheets("Names").Visible = xlSheetHidden
  Worksheets("Master").Visible = xlSheetHidden
  
  'Set the focus on the 'Table of Contents' Sheet
  Sheets("Table Of Contents").Select
  Range("A2").Select
          
  'Clear the Worksheet Object
  Set ws1 = Nothing
  
  MsgBox "Timesheet(s) Deleted:  " & iDeleteCount & vbCrLf & _
         "Timesheets(s) Added:  " & iAddCount
End Sub


Function LjmSheetExists(SheetName As String) As Boolean
'Return value TRUE if sheet exists

  On Error Resume Next

  If Sheets(SheetName) Is Nothing Then
    LjmSheetExists = False
  Else
    LjmSheetExists = True
  End If
  On Error GoTo 0
  
End Function


Sub SortTabsInAscendingOrder()
  'This sorts the 'Tabs' in the Active Workbook (in Ascending Order)
  'This first n sheets are not affected
  '
  '
  'Modify the following Line to add/subtract the number of sheets at the
  'beginning of the Workbook to be ignored during Sort
  Const nDoNotSortFirstFewSheetsCOUNT = 4
    
  Dim i As Integer
  Dim j As Integer
  Dim iSheetCount As Integer
  Dim iStartingSheet As Integer
  
  Dim sActiveSheet As String
  Dim sMyWorkbookName As String
  
  'Get the name of the Active Workbook
  sMyWorkbookName = ActiveWorkbook.Name
  
  'Get the name of the Active Sheet
  sActiveSheet = ActiveSheet.Name
    
  'Get the sheet count
  iSheetCount = Sheets.Count

  iStartingSheet = nDoNotSortFirstFewSheetsCOUNT + 1

  'Sort in ascending order and ignore the first n sheets
  For i = iStartingSheet To iSheetCount
    For j = iStartingSheet To iSheetCount - 1
      If UCase(Sheets(j).Name) > UCase(Sheets(j + 1).Name) Then
               Sheets(j).Move After:=Sheets(j + 1)
       End If
     Next j
  Next i
  
  'Move the focus back to the Active Sheet
  Workbooks(sMyWorkbookName).Activate
  Sheets(sActiveSheet).Select
  
  MsgBox "Sort Tabs (except first " & nDoNotSortFirstFewSheetsCOUNT & ") in Ascending Order Completed."
    
End Sub