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

[p45cal]

Try:

Sub blah()
    Dim NewSht As Worksheet
    Set Rng = Sheets("Database").Cells(1).CurrentRegion
    Set Rng = Intersect(Rng, Rng.Offset(1)).Resize(, 1)
    CurrentCat = ""
    For Each cll In Rng.Cells
        If cll.Value <> CurrentCat Then
            If Not NewSht Is Nothing Then NewSht.Columns("B:B").EntireColumn.AutoFit
                Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
                CurrentCat = cll.Value
            End If
            Set Destn = NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(2)
            With Destn
                .Value = cll.Offset(, 1).Value
                With .Font
                    .Name = "Calibri"
                    .Size = 11
                    .Underline = xlUnderlineStyleSingle
                    .Bold = True
                End With
            End With
            Set Destn = Destn.Offset(2)
            Destn.Resize(, 13).Value = Array("Hourly Table", "Column 1", "Column 2", "Column 3", "Column 4", "Column 5", "Column 6", "Column 7", _
            "Column 8", "Column 9", "Column 10", "Column 11", "Column 12")
            Set Destn = Destn.Offset(1)
            StartTime = cll.Offset(, 3).Value
            If TypeName(StartTime) = "String" Then StartTime = TimeValue(StartTime)
            EndTime = cll.Offset(, 4).Value
            If TypeName(EndTime) = "String" Then EndTime = TimeValue(EndTime)
            For hr = StartTime To EndTime Step 1 / 24
            Destn.Value = hr
            Destn.NumberFormat = "hh:mm AM/PM"
            Set Destn = Destn.Offset(1)
        Next hr
    Next cll
    If Not NewSht Is Nothing Then NewSht.Columns("B:B").EntireColumn.AutoFit
End Sub

Notes:
1. 12AM is midnight, 12PM is noon. You need to get these right on the Database sheet.
2. If you tell me how you formatted the green areas I'll add that in.

edit post posting: re-reading your msg#1 of this thread I see I've missed some points - give me some time…