Consulting

Page 4 of 6 FirstFirst ... 2 3 4 5 6 LastLast
Results 61 to 80 of 104

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

  1. #61
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    I need to add another table at the end of the last sub category's table.
    Attached Files Attached Files

  2. #62
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.

  3. #63
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Quote Originally Posted by p45cal View Post
    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)
    Yes, I got it working already however there are columns on the last table that I need merged

  4. #64
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by jazz2409 View Post
    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?
    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.

  5. #65
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Quote Originally Posted by p45cal View Post
    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

  6. #66
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.
    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.

  7. #67
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    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

  8. #68
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    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.

  9. #69
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by jazz2409 View Post
    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.
    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.

  10. #70
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    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

  11. #71
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.

  12. #72
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Quote Originally Posted by p45cal View Post
    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

  13. #73
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by jazz2409 View Post
    I created the table from scratch manually
    Yes! Do it again while recording a macro and post the code here.
    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.

  14. #74
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    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

  15. #75
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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?
    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.

  16. #76
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Hmmm I am honestly not sure how to change the current code into that

  17. #77
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.

  18. #78
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Here's my most recent workbook
    Attached Files Attached Files

  19. #79
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    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?

  20. #80
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Attached.
    Attached Files Attached Files
    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.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •