I need to add another table at the end of the last sub category's table.
I need to add another table at the end of the last sub category's table.
The last snippet I gave adds a table after the last sub category on every category (LOB) sheet.
To get one table after the last sub category on only the last category sheet, put your code just before End Sub, say in the vicinity of:
NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(2)
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:although in the context of creating a new table in code, these may not be the actual cells involved.Code:Range("B1:C1").HorizontalAlignment = xlCenterAcrossSelection
Range("D1:E1").HorizontalAlignment = xlCenterAcrossSelection
Range("F1:G1").HorizontalAlignment = xlCenterAcrossSelection
I've been locked out of my NT login at work and couldn't login to my work laptop :omg2: I will try this as soon as the IT department has fixed it :omg2:
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.
Here's the code I added:
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 thatCode: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
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)
Here's the code generated by the recorder. Please note that table headers and time under hourly table are pre-typed
Code: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
That code boils down to:Can you work with that?Code: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
Hmmm I am honestly not sure how to change the current code into that
OK, let's have the current version of the workbook…
Here's my most recent workbook
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?
Attached.