jazz2409
02-04-2020, 05:11 AM
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
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