Consulting

Results 1 to 6 of 6

Thread: Converting Tables Into ListObject

  1. 02-04-2020, 05:11 AM #1
    jazz2409
    jazz2409 is offline
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location

    Exclamation Converting Tables Into ListObject

    Okay so I have this code from Paul_Hossler which I added conditional formatting to. However my conditional formatting relies heavily on the tables being in a ListObject.

    Can anyone please help on how to convert the tables into ListObject, please? Thank you

    Sub MySubLOBs()

    Dim r As Range
    Dim collLOB As Collection, collLOBSubLOB As Collection
    Dim i As Long
    Dim v As Variant
    Dim pt As PivotTable
    
    Set r = Worksheets("Consolidated").Cells(1, 1).CurrentRegion
    
    Set collLOB = New Collection
    Set collLOBSubLOB = New Collection




    'get list of just LOBs
    For i = 2 To r.Rows.Count
        On Error Resume Next
        collLOB.Add r.Cells(i, 4).Value, r.Cells(i, 4).Value
        collLOBSubLOB.Add r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value, r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value
        On Error GoTo 0
    Next i


    Set pt = Worksheets("Temp1").PivotTables(1)


    'do LOB totals
    For i = 1 To collLOB.Count
    On Error Resume Next
        pt.PivotFields("LOB").ClearAllFilters
        pt.PivotFields("LOB").CurrentPage = collLOB.Item(i)
        pt.PivotFields("Sub LOB").ClearAllFilters
        'pt.TableStyle2 = "PivotStyleMedium7"
        'Call SubLOBs(pt, collLOB.Item(i), "Overall")
    Next i
    
    'do SubLOB totals
    For i = 1 To collLOBSubLOB.Count
        v = Split(collLOBSubLOB.Item(i), Chr(1))
        pt.PivotFields("LOB").ClearAllFilters
        pt.PivotFields("LOB").CurrentPage = v(0)
        pt.PivotFields("Sub LOB").ClearAllFilters
        pt.PivotFields("Sub LOB").CurrentPage = v(1)
        pt.TableStyle2 = "PivotStyleMedium7"
        Call SubLOBs(pt, CStr(v(0)), CStr(v(1)))
    Next i
    
End Sub


Sub SubLOBs(myPT As PivotTable, sLOB As String, sTitle As String)
    Dim r As Range, ws As Worksheets, LastTable As ListObject
        
    Set r = myPT.TableRange1
    cntListObjects = cntListObjects + 1
   
    With Worksheets(sLOB)
        
        With .Cells(.Rows.Count, 16).End(xlUp).Offset(3, 0)
              .Value = sTitle
              .Font.Name = "Calibri"
              .Font.Size = 11
              .Font.Underline = xlUnderlineStyleSingle
              .Font.Bold = True
        End With
        
        r.Copy .Cells(.Rows.Count, 16).End(xlUp).Offset(2, 0)
        r.TableStyle = "TableStyleMedium7"
                
        
    Set LastTable = Worksheets(sLOB).ListObjects.Add(xlSrcRange, r.CurrentRegion, , xlYes)
    
        'Fixing/Setting the range on which conditional formatting is to be desired
      Set rng1 = LastTable.ListColumns("FAHT > 90 days").DataBodyRange
      Set rng2 = LastTable.ListColumns("FAHT < 90 days").DataBodyRange
              
      'To delete/clear any existing conditional formatting from the range
       rng1.FormatConditions.Delete
       rng2.FormatConditions.Delete
    
      'Defining and setting the criteria for each conditional format
       Set condition1 = rng1.FormatConditions.Add(xlCellValue, xlEqual, "=0")
       Set condition2 = rng1.FormatConditions.Add(xlCellValue, xlGreater, "=$A$1")
       Set condition3 = rng1.FormatConditions.Add(xlCellValue, xlLess, "=$A$1")
       Set condition1a = rng2.FormatConditions.Add(xlCellValue, xlEqual, "=0")
       Set condition2a = rng2.FormatConditions.Add(xlCellValue, xlGreater, "=$B$1")
       Set condition3a = rng2.FormatConditions.Add(xlCellValue, xlLess, "=$B$1")
    
       rng1.FormatConditions(1).StopIfTrue = True
       rng1.FormatConditions(1).SetFirstPriority
       rng1.FormatConditions(2).StopIfTrue = False
       rng1.FormatConditions(3).StopIfTrue = False
    
       rng2.FormatConditions(1).StopIfTrue = True
       'rng2.FormatConditions(1).SetFirstPriority
       rng2.FormatConditions(2).StopIfTrue = False
       rng2.FormatConditions(3).StopIfTrue = False
       
       'Defining and setting the format to be applied for each condition
       With condition2
        .Font.Color = -16383844
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13551615
        .Interior.TintAndShade = 0
       End With
    
       With condition3
        .Font.Color = -16752384
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13561798
        .Interior.TintAndShade = 0
       End With
    
       With condition2a
        .Font.Color = -16383844
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13551615
        .Interior.TintAndShade = 0
       End With
    
       With condition3a
        .Font.Color = -16752384
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13561798
        .Interior.TintAndShade = 0
       End With


    End With
    
    
End Sub
    Reply With Quote Reply With Quote
  2. 02-04-2020, 07:56 AM #2
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    I think you skipped a couple of steps and had some in the wrong order

    I didn't have your post-processed data from the pivot table, so I had to fake it


    Option Explicit

Sub Demo3()
    Dim r As Range
    Dim collLOB As Collection, collLOBSubLOB As Collection
    Dim i As Long
    Dim v As Variant
    Dim pt As PivotTable
    
    Set r = Worksheets("Consolidated").Cells(1, 1).CurrentRegion
    
    Set collLOB = New Collection
    Set collLOBSubLOB = New Collection




    'get list of just LOBs
    For i = 2 To r.Rows.Count
        On Error Resume Next
        collLOB.Add r.Cells(i, 4).Value, r.Cells(i, 4).Value
        collLOBSubLOB.Add r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value, r.Cells(i, 4).Value & Chr(1) & r.Cells(i, 22).Value
        On Error GoTo 0
    Next i


    'delete existing LOB WS  and make new LOB WS
    For i = 1 To collLOB.Count
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets(collLOB.Item(i)).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        
        Worksheets.Add.Name = collLOB.Item(i)
    Next
        
    Set pt = Worksheets("Temp1").PivotTables(1)
    cntListObjects = 0




    'do LOB
    For i = 1 To collLOB.Count
        pt.PivotFields("LOB").ClearAllFilters
        pt.PivotFields("LOB").CurrentPage = collLOB.Item(i)
        pt.PivotFields("Sub LOB").ClearAllFilters


        Call SubLOBs(pt, collLOB.Item(i), "Overall")
    Next i
    
    'do SubLOB
    For i = 1 To collLOBSubLOB.Count
        v = Split(collLOBSubLOB.Item(i), Chr(1))
        pt.PivotFields("LOB").ClearAllFilters
        pt.PivotFields("LOB").CurrentPage = v(0)
        pt.PivotFields("Sub LOB").ClearAllFilters
        pt.PivotFields("Sub LOB").CurrentPage = v(1)


        Call SubLOBs(pt, CStr(v(0)), CStr(v(1)))
    Next i
End Sub


Sub SubLOBs(myPT As PivotTable, sLOB As String, sTitle As String)
    Dim LastTable As ListObject
    Dim r As Range, r2 As Range
    Dim rng1 As Range, rng2 As Range
    Dim condition1 As FormatCondition, condition2 As FormatCondition, condition3 As FormatCondition, _
        condition1a As FormatCondition, condition2a As FormatCondition, condition3a As FormatCondition
    
    Set r = myPT.TableRange1
    
    With Worksheets(sLOB)
        
        Set r2 = .Cells(.Rows.Count, 2).End(xlUp).Offset(3, 0)
        r2.Value = sTitle
        
        If sTitle = "Overall" Then
            With r2
              .Font.Name = "Calibri"
              .Font.Size = 11
              .Font.Underline = xlUnderlineStyleSingle
              .Font.Bold = True
            End With
        End If
        
        
        Set r2 = .Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0)
        r.Copy r2
    
        Set r2 = r2.CurrentRegion
    
        'make range into ListOject and add to array
        .ListObjects.Add(xlSrcRange, r2, , xlYes).Name = sLOB & "_" & sTitle
        Set LastTable = .ListObjects(sLOB & "_" & sTitle)
    End With
    
    'Fixing/Setting the range on which conditional formatting is to be desired
    With LastTable
        .TableStyle = "TableStyleMedium7"
'        Set rng1 = .ListColumns("FAHT > 90 days").DataBodyRange
'        Set rng2 = .ListColumns("FAHT < 90 days").DataBodyRange
        Set rng1 = .ListColumns("Sum of OB Hold").DataBodyRange     '<<<<<<<<<<<<<<<<<<<<<<<   I had to fake it
        Set rng2 = .ListColumns("Sum of OB Wrap").DataBodyRange
    End With
        
    'To delete/clear any existing conditional formatting from the range
    rng1.FormatConditions.Delete
    rng2.FormatConditions.Delete
    
    'Defining and setting the criteria for each conditional format
    Set condition1 = rng1.FormatConditions.Add(xlCellValue, xlEqual, "=0")
    Set condition2 = rng1.FormatConditions.Add(xlCellValue, xlGreater, "=$A$1")
    Set condition3 = rng1.FormatConditions.Add(xlCellValue, xlLess, "=$A$1")
    Set condition1a = rng2.FormatConditions.Add(xlCellValue, xlEqual, "=0")
    Set condition2a = rng2.FormatConditions.Add(xlCellValue, xlGreater, "=$B$1")
    Set condition3a = rng2.FormatConditions.Add(xlCellValue, xlLess, "=$B$1")
    
    rng1.FormatConditions(1).StopIfTrue = True
    rng1.FormatConditions(1).SetFirstPriority
    rng1.FormatConditions(2).StopIfTrue = False
    rng1.FormatConditions(3).StopIfTrue = False
    
    rng2.FormatConditions(1).StopIfTrue = True
    'rng2.FormatConditions(1).SetFirstPriority
    rng2.FormatConditions(2).StopIfTrue = False
    rng2.FormatConditions(3).StopIfTrue = False
    
    'Defining and setting the format to be applied for each condition
    With condition2
        .Font.Color = -16383844
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13551615
        .Interior.TintAndShade = 0
    End With
    
    With condition3
        .Font.Color = -16752384
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13561798
        .Interior.TintAndShade = 0
    End With
    
    With condition2a
        .Font.Color = -16383844
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13551615
        .Interior.TintAndShade = 0
    End With
    
    With condition3a
        .Font.Color = -16752384
        .Font.Bold = True
        .Font.TintAndShade = 0
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13561798
        .Interior.TintAndShade = 0
    End With
End Sub
    Attached Files Attached Files
    Last edited by Paul_Hossler; 02-04-2020 at 08:25 AM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
  3. 02-04-2020, 09:21 AM #3
    jazz2409
    jazz2409 is offline
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Yeah it works. Sorry my fault... Marking this as solved.. Can we delete this other thread? I was thinking it's a different thing so I made another thread
    Reply With Quote Reply With Quote
  4. 02-10-2020, 06:47 AM #4
    jazz2409
    jazz2409 is offline
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    Hi Paul, sorry I have a follow-up question. I need to put another filter to this, Designation. If the Designation is not equal to agent, they will not be included.
    Reply With Quote Reply With Quote
  5. 02-10-2020, 06:58 AM #5
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    Quote Originally Posted by jazz2409 View Post
    Hi Paul, sorry I have a follow-up question. I need to put another filter to this, Designation. If the Designation is not equal to agent, they will not be included.
    That's as easy as adding another Page Field to the pivot table on the hidden sheet Temp1 and setting it to "Agent"

    Capture.JPG


    I changed some data on Consolidated to test on ver 5 attached
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
  6. 02-10-2020, 07:03 AM #6
    jazz2409
    jazz2409 is offline
    VBAX Tutor
    Joined
    Jan 2020
    Posts
    204
    Location
    I added that already I thought I need to add it to the codes because I placed a refresh everytime the report is being run rofl thank you so much
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

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
  •  

Forum Rules