CODEWITHSUNDEEP
excelvba
walkn748
walkn748

Reputation: 31

Create and update sheets based on existing list

I am trying to customize a VBA code that will create new sheets based on a preexisting list. I am continually updating this list as more data is required. The VBA code (below) that I am using is able to create new sheets but I need to be able to update it (create new sheets) while ignoring sheets that have already been created. Any suggestions?

Sub CreateSheetsFromList()
Dim ws As Worksheet, Ct As Long, c As Range
Set ws1 = Worksheets("Template")
Set ws2 = Worksheets("Job List")
Application.ScreenUpdating = False
For Each c In Sheets("Job List").Range("A4:A51")
   If c.Value <> "" Then
       ws1.Copy after:=Sheets(Sheets.Count)
       ActiveSheet.Name = c.Value
       Ct = Ct + 1
   End If
Next c
If Ct > 0 Then
   MsgBox Ct & " new sheets created from list"
Else
   MsgBox "No names on list"
End If
Application.ScreenUpdating = True
End Sub

Upvotes: 3

Views: 54

Answers (1)

VBasic2008
VBasic2008

Reputation: 54983

Create Worksheets from a List

Option Explicit

Sub CreateSheetsFromList()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws1 As Worksheet: Set ws1 = wb.Worksheets("Template")
    Dim ws2 As Worksheet: Set ws2 = wb.Worksheets("Job List")
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim c As Range
    Dim Ct As Long
    For Each c In ws2.Range("A4:A51").Cells
       If Len(c.Value) > 1 Then
           On Error Resume Next
           Set ws = wb.Worksheets(c.Value)
           On Error GoTo 0
           If ws Is Nothing Then
               ws1.Copy After:=wb.Sheets(wb.Sheets.Count)
               ActiveSheet.Name = c.Value
               Ct = Ct + 1
           Else
               ' worksheet already exists
               Set ws = Nothing
           End If
       End If
    Next c
    
    Application.ScreenUpdating = True
    
    If Ct > 0 Then
       MsgBox Ct & " new sheets created from list"
    Else
       MsgBox "No non-existing worksheet names on list"
    End If

End Sub

Upvotes: 1

Related Questions