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

[jazz2409]

Here's the sample file

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

[p45cal]

Some changes:

Sub blah()
Dim NewSht As Worksheet, LastTable As ListObject
Set Rng = Sheets("Database").Cells(1).CurrentRegion
Set Rng = Intersect(Rng, Rng.Offset(1)).Resize(, 1)
'Rng.Select
CurrentCat = ""
EndTime = Application.WorksheetFunction.Floor_Math(Time, 1 / 24)
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))
    NewSht.Name = cll.Value
    CurrentCat = cll.Value
  End If
  Set Destn = NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(2)
  If Not LastTable Is Nothing Then LastTable.Unlist
  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
  Set LastTable = NewSht.ListObjects.Add(xlSrcRange, Destn.Offset(-1).CurrentRegion, , xlYes)
  With LastTable
    .TableStyle = "TableStyleMedium14"
    .ShowTableStyleRowStripes = False
    '.Unlist
  End With

Next cll
If Not LastTable Is Nothing Then LastTable.Unlist
If Not NewSht Is Nothing Then NewSht.Columns("B:B").EntireColumn.AutoFit
End Sub

The end time is the current time rounded down to the nearest hour. If you want it rounded up to the nearest hour then change Floor_Math to Ceiling_Math.
I've had a go at some formatting by temporarily converting to listobjects (Tables) and then converting back to a plain ranges.
If a sheet already exists, what do you want to happen?

I'll stop there and wait to hear from you.

[jazz2409]

you are my savior
If a sheet already exists I will only have to update each tables

[p45cal]

If a sheet already exists I will only have to update each tables

That could be very convoluted. Is there going to be data in those pre-existing tables? If so what happens to that data? What if the pre-existing table is from another day when it was created at a later time of day?
I'm not going to be in a hurry to spend lots of time on this one!

[jazz2409]

That could be very convoluted. Is there going to be data in those pre-existing tables? If so what happens to that data? What if the pre-existing table is from another day when it was created at a later time of day?
I'm not going to be in a hurry to spend lots of time on this one!

There will be data on each table. The report will be ran every hour. The data that will be captured for each hour should stay there. And this report is used daily so there will be no data from a different day

[jazz2409]

Also how do I set EndTime to get the value of a specific cell? I tried changing your EndTime to this:

EndTime = ThisWorkbook.Sheets("Scrubber").Range("D1").Value

cell D1 in sheet Scrubber has a formula of

=ROUNDDOWN(Scrubber!$B$1*24,0)/24

It's not working..I need the EndTime to get the value of cell D1

[jazz2409]

And do you think it will be easier to just pivot the data then put them in the tables rather than use formulas? I noticed that one formula significantly slowed down your code

[p45cal]

It's not working..I need the EndTime to get the value of cell D1

That should work. It depends what's in cell B1 though.

[p45cal]

And do you think it will be easier to just pivot the data then put them in the tables rather than use formulas? I noticed that one formula significantly slowed down your code

Pivot what data?
What formulae?

[jazz2409]

I have a sheet named Consolidated. It contains all data that I need to compute and segregate to each sub category.

So what happens in this report is this:

1) Get raw data from system
2) Dump to Excel Sheet
3) Process it and transfer to Consolidated Sheet
4) Compute for each Sub Category and segregate per hour per sub category
5) Repeat from 1 throughout the day

[jazz2409]

I'll attach a sample workbook in a bit

[jazz2409]

here's the sample workbook. with sample data

[p45cal]

re-instate one line:

EndTime = ThisWorkbook.Sheets("Scrubber").Range("D1").Value
If TypeName(EndTime) = "String" Then EndTime = TimeValue(EndTime)

should do it.

[jazz2409]

re-instate one line:

EndTime = ThisWorkbook.Sheets("Scrubber").Range("D1").Value
If TypeName(EndTime) = "String" Then EndTime = TimeValue(EndTime)

should do it.

Yes I tried that. It works but if it's 12PM, it only shows until 11AM

[p45cal]

Yes I tried that. It works but if it's 12PM, it only shows until 11AM

Change to:

  For hr = StartTime To EndTime + 0.0001 Step 1 / 24

[p45cal]

You've removed the penultimate line:

If Not LastTable Is Nothing Then LastTable.Unlist

which means that the last table created remains a listobject (Excel Table).

[p45cal]

On the consolidated sheet there are many rows for the same date/time/Lob/SubLob which you seem to want to put on one line in the new sheets. How are you summarising theose multiple rows?

[jazz2409]

Change to:

  For hr = StartTime To EndTime + 0.0001 Step 1 / 24

Worked like a charm
We're using GMT. Is there a need to change anything for that?

You've removed the penultimate line:
If Not LastTable Is Nothing Then LastTable.Unlist
which means that the last table created remains a listobject (Excel Table).

Do I add this after

Next cll
If Not NewSht Is Nothing Then NewSht.Columns("B:B").EntireColumn.AutoFit
If Not LastTable Is Nothing Then LastTable.Unlist

End Sub

?