Excel VBA Code to Create New Sheets Upon New Entry In Field

[IGPOD]

Okay, so I need a macro that will add new sheets to a workbook when new names are added to the specified field.

The code below is one which I found online and it works for the purposes of creating sheets per entry in the field (column A), however, whenever I add more names to the list in column A, and try to run the code again, I get an error message (see below)

Public Sub Extraction_to_new_sheets()
      
    Dim My_Range As Range
    Dim My_Cell As Variant
    Dim sh_Original As Worksheet
     
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
          
    Set sh_Original = ActiveSheet
     
    On Error Resume Next
    Sheets("TEMPXXX").Delete
    On Error GoTo 0
    Worksheets.Add
    ActiveSheet.Name = "TEMPXXX"
          
    Worksheets("Sheet1").Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Columns("A:A"), Unique:=True
     
    Set My_Range = Range("A2:A" & Range("A65536").End(xlUp).Row)
          
    For Each My_Cell In My_Range
        
        On Error Resume Next
        Sheets(My_Cell.Value).Delete 'delete if already exists
        On Error GoTo 0
        Worksheets.Add
        ActiveSheet.Name = My_Cell.Value
                 
        sh_Original.UsedRange.AutoFilter Field:=1, Criteria1:=My_Cell.Value
        sh_Original.Cells.SpecialCells(xlVisible).Copy Destination:=Range("A1")
        Columns.AutoFit
    Next
    
    Worksheets("TEMPXXX").Delete
    sh_Original.AutoFilterMode = False
    Set sh_Original = Nothing
     
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
     
End Sub

[westconn1]

the error probably indicates that you are again trying to add a sheet then giving the name of an existing sheet

you are first removing all sheets, but have no idea if they are all removed, as that code is masked by on error resume next
first REMOVE OERN, then if errors may occur, use proper methods to handle or eliminate errors
stop relying on the correct sheet being the active sheet
try like

set newsht = worksheets.add
newsht.name = my_cell.value
        sh_Original.UsedRange.AutoFilter Field:=1, Criteria1:=My_Cell.Value
        sh_Original.Cells.SpecialCells(xlVisible).Copy Destination:=newsht.Range("A1")
        newsht.Columns.AutoFit

[wrightyrx7]

Maybe this, would stop you having to re-run the code.

THis code will not delete/re-create the sheet if it already exists. Unless you want it to do that?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
    If Target.Column = 1 Then
        For Each ws In ActiveWorkbook.Worksheets
            If LCase(ws.Name) = LCase(Target.Cells.Value) Then Exit Sub
        Next ws
            Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Target.Cells.Value
    End If
End Sub