Creating Multiple Tables Using Loop in VBA. I still want to add new sheets and add

[jazz2409]

So, I need 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. The only difference is that I need to create multiple tables on button click and the times that it will list is from the start time that's indicated on the below table to the current time.

1.jpg

The Main Category becomes the sheet name and the Sub Categories per Main Category becomes each table's Title/Subject and NOT a header.
So for example, the first sub category's start time is 1AM and right now let's say it's 4AM. The tables should look like this:

2.jpg

If the Sub Category's start time is later than the current time, it should only show the Sub Category's name and the headers. So for example, let's use Main Category 2. It should look like this:

3.jpg

This is what I have so far:

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                       
             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

I also posted it here: https://stackoverflow.com/questions/...ng-loop-in-vba

Please help thank you