Converting Tables Into ListObject

[jazz2409]

Okay so I have this code from Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-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

[Paul_Hossler]

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

[jazz2409]

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

[jazz2409]

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.

[Paul_Hossler]

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"

25956


I changed some data on Consolidated to test on ver 5 attached

[jazz2409]

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 :)