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)
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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.Range("B1:C1").HorizontalAlignment = xlCenterAcrossSelection Range("D1:E1").HorizontalAlignment = xlCenterAcrossSelection Range("F1:G1").HorizontalAlignment = xlCenterAcrossSelection
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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
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
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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 thatTableHeaders1 = 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)
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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
That code boils down to:Can you work with that?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
Last edited by p45cal; 01-21-2020 at 09:06 AM.
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
Hmmm I am honestly not sure how to change the current code into that
OK, let's have the current version of the workbook…
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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.
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.