Create sheet from list error

[rsjury]

I am trying to create sheets from a list but if I run the code more than once I get an error as it try's to recreate the same sheets again (only want to create ones I have added. I also want sheets to delete if I remove the name from the list.

Sub test()

    Application.ScreenUpdating = False

lastcell = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 6 To lastcell

With ThisWorkbook
newname = Sheet1.Cells(i, 1).Value
.Sheets.Add after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = newname
End With

Next

    Application.ScreenUpdating = True

End Sub

 

[Yongle]

Try this - assumes that sheet with codename Sheet1 is the sheet containing your list - that is what is in your code
Warning Sheet1 is not necessarily either sheet named "Sheet1" [ code = Sheets("Sheet1") ] not the first sheet in the workbook [ code = Sheets(1) ]

Sub DeleteAddSheets()
    Dim ws As Worksheet, wsName As String, cel As Range, Rng As Range

'add sheets
    Application.ScreenUpdating = True
    Set Rng = Sheet1.Range("A1", Sheet1.Cells(Rows.Count, 1).End(xlUp))
   
    For Each cel In Rng
        wsName = cel.Value
        On Error Resume Next
            Debug.Print Sheets(wsName).Name
            If Err.Number <> 0 Then
                Sheets.Add after:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = wsName
            End If
        On Error GoTo 0
    Next cel
   
'delete sheets
    Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Worksheets
            wsName = ws.Name
            If wsName <> Sheet1.Name And WorksheetFunction.CountIf(Rng, wsName) = 0 Then ws.Delete
        Next ws
    Application.DisplayAlerts = True
    Sheet1.Activate
End Sub

 

[rsjury]

AWESOME, Thanks!

Only changed A1 to A6 and it works perfectly!