How can I add another loop to insert worksheets based on a list?

[kbj0109]

I want to add a loop that create worksheets with the same name on the list, if the workbook does not have the same named worksheets in a list.
How would I add it on this code?
Can anyone do it..?

Sub DeleteSheet()
Dim WS As Worksheet, SheetsToKeep As String
Const SheetNameWithList As String = "List"
''''First worksheet has the list, and Cell A1 is the title of list
SheetsToKeep = "/" & SheetNameWithList & "/" & Join(Application.Transpose( _
Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value), "/") & "/"
Application.DisplayAlerts = False
On Error Resume Next
For Each WS In ThisWorkbook.Worksheets
If InStr(SheetsToKeep, "/" & WS.Name & "/") = 0 Then WS.Delete
Next
On Error GoTo 0
Application.DisplayAlerts = True




End Sub

 

[RickXL]

Hi,

I would write it like this:

Sub CreateAndDeleteSheet()
    
    Dim r As Range
    Dim rList As Range
    Dim wsFound As Boolean
    Dim wsList As Worksheet
    
    With ThisWorkbook

        Set wsList = .Worksheets("List")
    
        With wsList
            Set rList = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
        End With
        
        For Each WS In .Worksheets
            wsFound = False
            For Each r In rList
                If (WS.Name = r.Value) Or (WS.Name = wsList.Name) Then
                    wsFound = True
                    Exit For
                End If
            Next
            If Not wsFound Then
                Application.DisplayAlerts = False
                WS.Delete
                Application.DisplayAlerts = True
            End If
        Next
        
        For Each r In rList
            wsFound = False
            For Each WS In .Worksheets
                If WS.Name = r.Value Then
                    wsFound = True
                    Exit For
                End If
            Next
            If Not wsFound Then
                Set WS = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
                WS.Name = r.Value
            End If
        Next
        
    End With
    
End Sub

This macro does both the delete and create worksheet steps.

First it goes through the list of worksheets in the workbook and checks to see if it is in the list in column A. If it is not then it deletes the worksheet.

Second, it goes through the list of names in column A and checks that against the current list of worksheets in the workbook. Any missing ones are created and placed at the end.