Creating worksheets and naming them with the values in a list/table

Question

I am trying to create multiple worksheet in a workbook and name them based on a contents in a particular table. I am doing this as the list can be dynamic and might need to create more/less sheets depending on the requirement.

Sub CreateSheetsFromList()

Dim NewSheet As Worksheet
Dim x As Integer
Dim tbl As ListObject
Dim cell As Range


  Application.ScreenUpdating = False

  Set tbl = Worksheets("Sheet1").ListObjects("Table1")


  For Each cell In tbl.DataBodyRange.Cells
    If SheetExists(cell.Value) = False And cell.Value <> "" Then
      Set NewSheet = Sheets.Add(after:=Sheets(Sheets.Count))
      NewSheet.Name = cell.Value
    End If
  Next cell

  Application.ScreenUpdating = True
  
End Sub

Function SheetExists(SheetName As String) As Boolean

Dim sht As Worksheet


  On Error Resume Next
    Set sht = ActiveWorkbook.Worksheets("Sheet1")
  On Error GoTo 0


  If Not sht Is Nothing Then SheetExists = True

  Set sht = Nothing

End Function

Unable to get any kind of results. Please let me know if there is a way to do this in an optimized manner

Your function is wrong, e.g. see https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists — SJR, Dec 09 '22 at 11:55

score -1 · Answer 1 · answered Dec 09 '22 at 13:16

-1

You have to use the passed variable to check - not a fixed value ("Sheet1"):

Function SheetExists(SheetName As String) As Boolean

  Dim sht As Worksheet

  On Error Resume Next
   'Use the passed SheetName to test for
    Set sht = ActiveWorkbook.Worksheets(SheetName)
  On Error GoTo 0

  If Not sht Is Nothing Then SheetExists = True

End Function

answered Dec 09 '22 at 13:16

Ike

9,580
4
13
29

I'm not sure this resolves the issue raised – JB-007 Dec 10 '22 at 23:54
At least it will resolve one basic issue of the code - as "sheet1" exists and none of the cell values will ever get to sheets.add ... – Ike Dec 11 '22 at 10:08
True that. 4 more to go., (characters! :)) – JB-007 Dec 12 '22 at 02:42

score -1 · Answer 2 · answered Dec 10 '22 at 05:15

Add Sheets From Excel Table (`ListObject`)

Utilization

Sub AddSheetsFromListObjectTEST()
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    AddSheetsFromListObject wb, "Sheet1", "Table1", 1
End Sub

The Method

Sub AddSheetsFromListObject( _
        ByVal wb As Workbook, _
        ByVal WorksheetID As Variant, _
        ByVal ListObjectID As Variant, _
        ByVal ListColumnID As Variant)
    Const PROC_TITLE As String = "Create Sheets From ListObject"
    On Error GoTo ClearError
    
    Dim sws As Worksheet: Set sws = wb.Sheets(WorksheetID)
    Dim slo As ListObject: Set slo = sws.ListObjects(ListObjectID)
    Dim slc As ListColumn: Set slc = slo.ListColumns(ListColumnID)
    Dim srg As Range: Set srg = slc.DataBodyRange
    
    Dim dws As Worksheet, sCell As Range, dName As String, NotRenamed As Boolean
    
    For Each sCell In srg.Cells
        dName = CStr(sCell.Value)
        If dws Is Nothing Then
            Set dws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        End If
        On Error GoTo RenameError
            dws.Name = dName
        On Error GoTo ClearError
        If NotRenamed Then NotRenamed = False Else Set dws = Nothing
    Next sCell
            
    If Not dws Is Nothing Then
        Application.DisplayAlerts = False
            dws.Delete
        Application.DisplayAlerts = True
    End If
  
ProcExit:
    Exit Sub
RenameError:
    'Debug.Print "Name = """ & dName & """" & vbLf & Left(Err.Description, 48)
    NotRenamed = True
    Resume Next
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub

covers the exact same areas I did --down to error reprorinng - all except for the reserved sheets which seems new - remarkable. (although will give it to you - code much more succinct/legit - so kudos on upgrades ☺) — JB-007, Dec 11 '22 at 00:02

Creating worksheets and naming them with the values in a list/table

2 Answers2

Add Sheets From Excel Table (ListObject)

Add Sheets From Excel Table (`ListObject`)