Adding Tables using Excel VBA

I want to add new sheets and add tables in these new sheets, using vba. As shown in the image below, there are two column Main Category and Sub Category. I want to create new sheet for every Main Category and add tables for every Sub Category based on the sheet it belongs to. Additionally I may add new entries to Main Category and Sub Category, the vba code should add sheet and tables for those as well.
<br><br>
<hr>
So far I am able to add the new sheets , but couldn't add the tables , This is what I have:

    Sub CreateSheetsFromAList()
        Dim MyCell As Range, myRange As Range
        Dim MyCell1 As Range, myRange1 As Range
        Dim WSname As String
                
        Sheet1.Select
        Range("A2").Select
        Range(ActiveCell, ActiveCell.End(xlDown)).Select
        Set myRange = Selection
        Application.ScreenUpdating = False
        
         For Each MyCell In myRange
            If Len(MyCell.Text) > 0 Then
                'Check if sheet exists
                If Not SheetExists(MyCell.Value) Then
                
                    'run new reports code until before Else
                    
                    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
                    Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
                                    
                    WSname = MyCell.Value 'stores newly created sheetname to a string variable
                   
                    'filters consolidated sheet based on newly created sheetname
                    Sheet3.Select
                    Range("A:T").AutoFilter
                    Range("D1").Select
                    Range("D1").AutoFilter Field:=4, Criteria1:=WSname, Operator:=xlFilterValues
                    
                    Range("A1:U1").Select
                    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
                    Range("A1:U" & lastRow).Select
                    Selection.Copy 'copies filtered data
                    
                    'search and activate WSname
                    ChooseSheet WSname
                    
                    Range("AH2").Select
                    ActiveCell.PasteSpecial xlPasteValues
                    
                    Range("AJ:AJ").Select
                    Selection.NumberFormat = "hh:mm"
                    Range("B2").Select
                 End If
            End If
                                                  
        Next MyCell
       
        End Sub
    
         Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
        Dim sht As Worksheet
    
         If wb Is Nothing Then Set wb = ThisWorkbook
         On Error Resume Next
         Set sht = wb.Sheets(shtName)
         On Error GoTo 0
         SheetExists = Not sht Is Nothing
         End Function
    
        Public Sub ChooseSheet(ByVal SheetName As String)
        Sheets(SheetName).Select
        End Sub

End result looks like this:

Here's my sample workbook without any codes: https://drive.google.com/file/d/16logfbrvoK3CVKb-j-g4167pvU_BoWYI/view?usp=sharing

This approach should get you started.

> Note: There are several TODOs in the code's comments.

Steps:

1. Convert your database range to an Excel structured table called (TableDatabase).

See this article

2. Add this code behind the sheet "Database"

   Option Explicit

   Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    DatabaseManager.Change Target
    Application.ScreenUpdating = True
   

   End Sub

3. Add a module and call it "DatabaseManager"

4. Add this code to the DatabaseManager module:

   Option Explicit

   Private Const DATABASE_TABLE_NAME As String = "TableDatabase"
   Private Const DATABASE_MAINCAT_COLUMN_HEADER As String = "Main Category"
   Private Const DATABASE_SUBCAT_COLUMN_HEADER As String = "Sub Category"

   Private Const TABLE_OFFSET_ROWS As Long = 5
   Private Const TABLE_COLUMN_LOCATION As Long = 1 ' 1 = A

   Public Sub Change(ByVal Target As Range)

    Dim databaseTable As ListObject
    Dim tableRow As Long
   
    Set databaseTable = Range(DATABASE_TABLE_NAME).ListObject
   
    Select Case True
    Case Not Intersect(Target, databaseTable.ListColumns(DATABASE_MAINCAT_COLUMN_HEADER).DataBodyRange) Is Nothing
        ' TODO: Validate if adding, updating or deleting a main category
   
        ' Case: Add a main category sheet
        AddSheetByTitle Target.Value2, Target.Parent
   
        ' TODO: Case updating, deleting
   
    Case Not Intersect(Target, databaseTable.ListColumns(DATABASE_SUBCAT_COLUMN_HEADER).DataBodyRange) Is Nothing
        ' TODO: Validate if adding, updating  or deleting a sub category
        tableRow = Target.Row - databaseTable.HeaderRowRange.Row + 1
   
        ' Case: Add a subcategory table
        AddTableInSheetByName databaseTable.ListColumns(DATABASE_MAINCAT_COLUMN_HEADER).Range(tableRow), Target.Value2, Target.Parent
   
        ' TODO: Case updating, deleting
   
    Case Else
   
    End Select
   

   End Sub

   Public Function AddSheetByTitle(ByVal Title As String, Optional ByVal ReturnSheet As Worksheet) As Worksheet

    ' TODO: Validate if sheet name is valid
   
    If SheetExists(Title) = True Then Exit Function
   
    Dim newWorksheet As Worksheet
    Set newWorksheet = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
   
    ' Rename the new sheet
    newWorksheet.Name = Title
   
    ' Return to a previous sheet
    If Not ReturnSheet Is Nothing Then ReturnSheet.Activate
   
    Set AddSheetByTitle = newWorksheet
   

   End Function

   Public Function AddTableInSheetByName(ByVal TargetSheetName As String, ByVal TableName As String, Optional ByVal ReturnSheet As Worksheet) As ListObject

    Dim targetSheet As Worksheet
    Dim targetTable As ListObject
    Dim lastRow As Long
   
    If SheetExists(TargetSheetName) = False Then
        Set targetSheet = AddSheetByTitle(TargetSheetName)
    End If
   
    If TableExists(TableName) = True Then Exit Function
   
    Set targetSheet = ThisWorkbook.Worksheets(TargetSheetName)
   
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
   
    Set targetTable = targetSheet.ListObjects.Add(SourceType:=xlSrcRange, Source:=targetSheet.Cells(lastRow, TABLE_COLUMN_LOCATION).Offset(TABLE_OFFSET_ROWS))
   
    targetTable.Name = TableName
   
    ' Set table headers and content
    targetTable.HeaderRowRange.Cells(1).Value2 = TableName
   
    ' Return to a previous sheet
    If Not ReturnSheet Is Nothing Then ReturnSheet.Activate
   

   End Function

   Private Function SheetExists(ByVal SheetName As String) As Boolean
   Dim evalSheet As Worksheet

    On Error Resume Next
    Set evalSheet = ThisWorkbook.Sheets(SheetName)
    On Error GoTo 0
   
    SheetExists = (Not evalSheet Is Nothing)
   

   End Function

   Private Function TableExists(ByVal TableName As String) As Boolean
   Dim evalTable As ListObject
   Dim evalName As String
   ' TODO: check if TableName is valid (search for invalid chars)
   evalName = Replace(TableName, " ", "_")
   On Error Resume Next
   TableExists = (Range(evalName).ListObject.Name = TableName)
   On Error GoTo 0
   End Function

> Note: Your end result belongs to an specific type of table. My code
> adds (as you initially asked) a new table to the sheet. The alternative would be to copy (duplicate) a source table and rename it.

Hope this helps. Remember to mark the answer if it does.