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

[p45cal]

there are columns on the last table that I need merged

Your file has an extra sheet new table, but no indication of what you want merged, nor any new code. It stumps me that you create a new table AND then want to merge columns, why not create a single column to hold the information you want in the first place?

[jazz2409]

Your file has an extra sheet new table, but no indication of what you want merged, nor any new code. It stumps me that you create a new table AND then want to merge columns, why not create a single column to hold the information you want in the first place?

Sorry I forgot to indicate on that sheet what needs to be merged *facepalm*
I need to merge cell B1 and C1, D1 and E1, and F1 and G1

[p45cal]

Merged cells and vba are notoriuosly difficult to work with in VBA although your requirement here is quite simple and probably trouble-free it's infinitely preferable to use Centre-across-Selection, achievable by selecting the 2 cells, going into Format cells…, Alignment tab and choosing Centre Across Selection in the Horizontal: field.
In code that translates to the likes of:

    Range("B1:C1").HorizontalAlignment = xlCenterAcrossSelection
    Range("D1:E1").HorizontalAlignment = xlCenterAcrossSelection
    Range("F1:G1").HorizontalAlignment = xlCenterAcrossSelection

although in the context of creating a new table in code, these may not be the actual cells involved.

[jazz2409]

I've been locked out of my NT login at work and couldn't login to my work laptop I will try this as soon as the IT department has fixed it

[jazz2409]

Okay so I was able to put the formula for the columns for the last table I was trying to put but I can't make it look like the table on the file I previously attached.

[p45cal]

I can't make it look like the table on the file I previously attached.

Well, I have to throw it back over to you; how did you make that table look like it looks?!
Perhaps record a macro of you making the table look as you want it? Otherwise describe the steps you took here.

[jazz2409]

Here's the code I added:

TableHeaders1 = Array(".", "IB AHT", ".", "OB AHT", ".", "Full AHT", ".")
TableHeaders2 = Array("Hourly Table", "IB > 90 days", "IB < 90 days", "OB > 90 days", "OB < 90 days", "FAHT > 90 days", "FAHT < 90 days")


If Cll.Offset(1).Value <> CurrentCat Then    NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(2).Select
    'Create the Tenure Table here:
    Set Destn = NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(2)
    'optionally convert table to plain range (next line only):
    If Not LastTable Is Nothing Then LastTable.Unlist
    With Destn
      .Value = CurrentCat & " Tenure-Wise Summary"
      With .Font
        .Name = "Calibri"
        .Size = 11
        .Underline = xlUnderlineStyleSingle
        .Bold = True
      End With
    End With
    Set Destn = Destn.Offset(2)
    'Destn.Resize(, 7).Value = TableHeaders1
    'Set Destn = Destn.Offset(1)
    Destn.Resize(, 7).Value = TableHeaders2
    Set Destn = Destn.Offset(1)
    StartTime = Cll.Offset(, 3).Value
    If TypeName(StartTime) = "String" Then StartTime = TimeValue(StartTime)
    For hr = StartTime To EndTime + 0.0001 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
      'add TENURE-WISE formulae here.
      On Error Resume Next
      .ListColumns("IB > 90 days").DataBodyRange.FormulaR1C1 = "=IFERROR(SUMIFS(Consolidated!C12,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure > 90 days"",Consolidated!C4,""" & CurrentCat & """)/SUMIFS(Consolidated!C11,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure > 90 days"",Consolidated!C4,""" & CurrentCat & """),0)"
      .ListColumns("IB < 90 days").DataBodyRange.FormulaR1C1 = "=IFERROR(SUMIFS(Consolidated!C12,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure < 90 days"",Consolidated!C4,""" & CurrentCat & """)/SUMIFS(Consolidated!C11,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure < 90 days"",Consolidated!C4,""" & CurrentCat & """),0)"
      .ListColumns("OB > 90 days").DataBodyRange.FormulaR1C1 = "=IFERROR(SUMIFS(Consolidated!C17,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure > 90 days"",Consolidated!C4,""" & CurrentCat & """)/SUMIFS(Consolidated!C16,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure > 90 days"",Consolidated!C4,""" & CurrentCat & """),0)"
      .ListColumns("OB < 90 days").DataBodyRange.FormulaR1C1 = "=IFERROR(SUMIFS(Consolidated!C17,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure < 90 days"",Consolidated!C4,""" & CurrentCat & """)/SUMIFS(Consolidated!C16,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure < 90 days"",Consolidated!C4,""" & CurrentCat & """),0)"
      .ListColumns("FAHT > 90 days").DataBodyRange.FormulaR1C1 = "=IFERROR(IF([@[OB > 90 days]]="""",[@[IB > 90 days]],[@[IB > 90 days]]+[@[OB > 90 days]]*SUMIFS(Consolidated!C16,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure > 90 days"",Consolidated!C4,""" & CurrentCat & """)/SUMIFS(Consolidated!C11,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure > 90 days"",Consolidated!C4,""" & CurrentCat & """)),0)"
      .ListColumns("FAHT < 90 days").DataBodyRange.FormulaR1C1 = "=IFERROR(IF([@[OB < 90 days]]="""",[@[IB < 90 days]],[@[IB < 90 days]]+[@[OB < 90 days]]*SUMIFS(Consolidated!C16,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure < 90 days"",Consolidated!C4,""" & CurrentCat & """)/SUMIFS(Consolidated!C11,Consolidated!C3,[@[Hourly Table]],Consolidated!C10,""Tenure < 90 days"",Consolidated!C4,""" & CurrentCat & """)),0)"
      .ListColumns("Hourly Table").DataBodyRange.NumberFormat = "hh:mm AM/PM"
      Range(.ListColumns(2).DataBodyRange, .ListColumns(7).DataBodyRange).NumberFormat = "0;-0;;@"
      'convert to plain values:
      '.DataBodyRange.Value = .DataBodyRange.Value
    End With
  End If

The headers on TableHeaders2 aren't really supposed to be like that, I just don't know how to make the table look like the one on the Excel file I previously posted. The code above works however the table isn't supposed to look like that

[p45cal]

I'm in a rush, just going out...
the code you've given seems to show what doesn't work; what I'm asking is how you made that table look like it does: what formatting did you apply to make it like that? Record a new macro of you creating that table and how it looks, and post that entirely new code here. Sorry, gotta go. (A few hours)

[jazz2409]

I'm in a rush, just going out...
the code you've given seems to show what doesn't work; what I'm asking is how you made that table look like it does: what formatting did you apply to make it like that? Record a new macro of you creating that table and how it looks, and post that entirely new code here. Sorry, gotta go. (A few hours)

I created the table from scratch manually

[p45cal]

I created the table from scratch manually

Yes! Do it again while recording a macro and post the code here.

[jazz2409]

Here's the code generated by the recorder. Please note that table headers and time under hourly table are pre-typed

Sub Macro3()'
' Macro3 Macro
'


'
    Range("I1:O2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("I3:O13").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("I:O").Select
    Range("I2").Activate
    Columns("I:O").EntireColumn.AutoFit
    Columns("I:O").EntireColumn.AutoFit
    ActiveWindow.ScrollRow = 1
    Range("J1:K1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("L1:M1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("N1:O1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
End Sub

[p45cal]

That code boils down to:

Sub Macro3b()
With Range("I1:O2")
  .Interior.Color = 2315831
  .Font.Color = 16777215
  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlCenter
End With
With Range(Range("I3:O13"), Range("I3:O13").End(xlDown))
  .Interior.Color = 11854022
  With Intersect(.Cells, .Cells.Offset(, 1))
    .HorizontalAlignment = xlCenter    'you didn't have this but you may want it
    .VerticalAlignment = xlCenter    'you didn't have this but you may want it
  End With
  With .Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Color = 16777215
  End With
  Range("J1:K1").HorizontalAlignment = xlCenterAcrossSelection
  Range("L1:M1").HorizontalAlignment = xlCenterAcrossSelection
  Range("N1:O1").HorizontalAlignment = xlCenterAcrossSelection
  .EntireColumn.AutoFit
End With
End Sub

Can you work with that?

[jazz2409]

Here's my most recent workbook

[jazz2409]

Hmmm I am honestly not sure how to change the current code into that

[p45cal]

OK, let's have the current version of the workbook…

[jazz2409]

by the way I have another question. I am working on two sites: let's say Site A and Site B. Site A does not require the overall table, but Site B does. How do I do that?

[p45cal]

Attached.

[p45cal]

by the way I have another question. I am working on two sites: let's say Site A and Site B. Site A does not require the overall table, but Site B does. How do I do that?

There is no site data in the files you've attached here.
Is the site information to be found in column R of the Database sheet?
Will the site be the same for every row on the Consolidated sheet (Column U?)?
Can it change from LOB to LOB?
Can it change from Sub LOB to Sub LOB within a LOB?

[jazz2409]

There is no site data in the files you've attached here.
Is the site information to be found in column R of the Database sheet?
Will the site be the same for every row on the Consolidated sheet (Column U?)?
Can it change from LOB to LOB?
Can it change from Sub LOB to Sub LOB within a LOB?

Is the site information to be found in column R of the Database sheet? - Yes
Will the site be the same for every row on the Consolidated sheet (Column U?)? - No
Can it change from LOB to LOB? - Yes
Can it change from Sub LOB to Sub LOB within a LOB? - Yes


I attached your workbook with Site information..

Also, is there a way to remove IB, OB, and FAHT from the table headers below and leave < 90 days or > 90 days while still being able to apply their corresponding formula?

IB > 90 days IB < 90 days OB > 90 days OB < 90 days FAHT > 90 days FAHT < 90 days

[p45cal]

Site A does not require the overall table, but Site B does. How do I do that?

The overall table is at the bottom (edit: that should be top) of each LOB sheet which contains several sub LOBS. Some of those sub LOBS are on Site A, others on Site B [Can it change from Sub LOB to Sub LOB within a LOB? - Yes]. What to do?
(I haven't looked at your latest attachment yet.)

Also, is there a way to remove IB, OB, and FAHT from the table headers below and leave < 90 days or > 90 days while still being able to apply their corresponding formula?

Yes, that will be included in the next version.