VBA Conditional Format List Object Table

Amapola · Aug 30, 2021

Good Afternoon

I'm trying to get VBA to format a report I have to do regularly. I want to format the entire row depending on value in one of the columns. As the view can change and that might impact the columns the report downloads, I'm formatting the data as a table and want to use the table header to determine which column to use as a condition. I also want to delete a couple of columns after that.
Finally, I want to save the file as xlsx with the calculated filename.

I get an error 438 on this line, Object doesn't support this property
tbl.DataBodyRange.Rows.FormatConditions.Interior.Color = RGB(205, 5, 5)

I have tried various ways to mimic conditional formatting in VBA but none work. Note, it does not need to be dynamic.

Anybody see where I go wrong?

Thanks, Christine

VBA Code:

Sub CalDueReport()


Dim shTable As Worksheet
Set shTable = Sheets("Table")
    
    Application.CutCopyMode = False
    
'Convert to Table
Dim tbl As ListObject
Dim src As Range
Set src = Range("A1").CurrentRegion
    ActiveSheet.ListObjects.Add(SourceType:=xlSrcRange, Source:=src, xlListObjectHasHeaders:=xlYes).Name = _
        "CalDue"
    Range("CalDue[#All]").Select
    ActiveSheet.ListObjects("CalDue").TableStyle = "TableStyleMedium1"
Set tbl = shTable.ListObjects("CalDue")

Dim sortcolumn As Range
Set sortcolumn = Range("CalDue[Calibration due]")
With tbl.Sort
   .SortFields.Clear
   .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
   .Header = xlYes
   .Apply
End With

'today's date for condition and file name
Dim CurrDate As Date
CurrDate = Date
Dim ReportDate As String
ReportDate = Format(Date, "yyyy-mm-dd")

'Delete any existing Conditional Formatting
tbl.DataBodyRange.FormatConditions.Delete


'Overdue
tbl.DataBodyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=CurrDate > INDIRECT(""CalDue[@Calibration due]"")"
tbl.DataBodyRange.Rows.FormatConditions.Interior.Color = RGB(205, 5, 5)

'Next Month
tbl.DataBodyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=CurrDate + 30 > INDIRECT(""CalDue[@Calibration due]"")"
tbl.DataBodyRange.Rows.FormatConditions.Interior.Color = RGB(255, 155, 50)

'Next 3 months
tbl.DataBodyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=CurrDate + 90 > INDIRECT(""CalDue[@Calibration due]"")"
tbl.DataBodyRange.Rows.FormatConditions.Interior.Color = RGB(250, 250, 5)

'Next 6 monts
tbl.DataBodyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=CurrDate +180 > INDIRECT(""CalDue[@Calibration due]"")"
tbl.DataBodyRange.Rows.FormatConditions.Interior.Color = RGB(50, 200, 200)



'Delete Column Tool type
tbl.ListColumns("Category").Delete


'Delete Last Table Row
tbl.TotalsRowRange.Delete

'Hide Items not calibrated
Dim iCol As Long
iCol = tbl.ListColumns("Status").Index
    tbl.ListObjects("CalDue").AutoFilter Field:=iCol, _
    Criteria1:=Array("Ready to Deploy", "Ready to Deploy Deployed", "Calibration Overdue - Do not use", "Calibration Overdue - Do not use Deployed")
          

'Save as report with month date
Dim ReportName As String
ReportName = "CalDueReport_" & ReportDate & ".xlsx"
ActiveWorkbook.SaveAs Filename:="C:\UserData\XXXX\XXXX\XXXX\" & ReportName, FileFormat:=51

    
End Sub

bobsan42 · Aug 31, 2021

FormatConditions is a collection.
To refer to a certain CF you need to use for example FormatConditions(1).
Then the formatting is a bit more complicated than that if i recall correctly, but i may be wrong ... Use the Macro recorder to figure it out.

Amapola · Aug 31, 2021

Thanks for the hint, bobsan42. Not much experience with collections, will read up. If I work it out, I will post code here.

bobsan42 · Sep 1, 2021

Amapola said:
Thanks for the hint, bobsan42. Not much experience with collections, will read up. If I work it out, I will post code here.

In your case this is a collection of all formatting conditions you have applied to a cell or range. To refer to a one of those you must use it's index number e.g.

VBA Code:

 tbl.DataBodyRange.FormatConditions(1)

Amapola · Sep 5, 2021

I have done some more on this but I'm no further. I can't find any reference on what should be the proper procedure to apply Conditional Formatting in a table (ListObject). Mostly, what I can find applies conditional formatting on a column but I'm trying to apply it to the entire row.

There is an object ListRows but that doesn't seem to take FormatConditions. As it is, the code turns everything red which means not only does it apply the first condition wrong but doesn't move on to the other conditions. I've seen Select Case used for Conditional Formatting but not with a formula and I can't make that work. And looping through the body range doesn't do anything either.

Pretty much at my wits end. Maybe Conditional Formatting with multiple rules just doesn't work with a table?

VBA Code:

Sub zCalDueReport()
' zCalDueReport Macro
'
Dim shTable As Worksheet
Set shTable = Sheets("Table")
    
    Application.CutCopyMode = False
    
'Convert to Table
Dim tbl As ListObject
Dim src As Range
Set src = Range("A1").CurrentRegion
    ActiveSheet.ListObjects.Add(SourceType:=xlSrcRange, Source:=src, xlListObjectHasHeaders:=xlYes).Name = _
        "CalDue"
    Range("CalDue[#All]").Select
    ActiveSheet.ListObjects("CalDue").TableStyle = "TableStyleMedium1"
Set tbl = shTable.ListObjects("CalDue")

Dim sortcolumn As Range
Set sortcolumn = Range("CalDue[Calibration due]")
With tbl.Sort
   .SortFields.Clear
   .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
   .Header = xlYes
   .Apply
End With

'today's date for condition and file name
Dim CurrDate As Date
CurrDate = Date
Dim ReportDate As String
ReportDate = Format(Date, "yyyy-mm-dd")

'Delete any existing Conditional Formatting
tbl.DataBodyRange.FormatConditions.Delete

Dim LRows As Object
Dim LRow As Object
Set LRows = tbl.ListRows
Dim CFormat As FormatCondition

'Delete any existing Conditional Formatting
tbl.DataBodyRange.FormatConditions.Delete

    With tbl.DataBody.Range

    'First Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & CurrDate & "< INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(1).StopIfTrue = False
    .FormatConditions(1).Interior.Color = RGB(205, 5, 5)
    
    'Second Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & CurrDate + 30 & "< INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(2).StopIfTrue = False
    .FormatConditions(2).Interior.Color = RGB(255, 155, 50)

    
    'Third Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & CurrDate + 90 & "< INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(3).StopIfTrue = False
    .FormatConditions(3).Interior.Color = RGB(250, 250, 5)
    
    'Fourth Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & CurrDate + 180 & "< INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(4).StopIfTrue = False
    .FormatConditions(4).Interior.Color = RGB(50, 200, 200)
    
    End With
   

'Delete Column Tool type
tbl.ListColumns("Category").Delete
tbl.ListColumns("Purchase Cost").Delete


'Hide Items not calibrated
Dim iCol As Long
iCol = tbl.ListColumns("Status").Index
    tbl.DataBodyRange.AutoFilter Field:=iCol, Criteria1:="<>*not calibrated*"
          

'Save as report with month date
Dim ReportName As String
ReportName = "CalDueReport_" & ReportDate & ".xlsx"
ActiveWorkbook.SaveAs Filename:="C:\UserData\xxx\" & ReportName, FileFormat:=51

End Sub

bobsan42 · Sep 6, 2021

FormatConditions applies to Range. To refer to the range of a listobject use:

VBA Code:

Tbl.databodyrange.formatconditions

Or

VBA Code:

Tbl.listrows(1).range.formatconditions

Amapola · Sep 6, 2021

@bobsan42 - Pretty sure that's what I'm doing so I don't think that's the error.

Fluff · Sep 6, 2021

Try it like

VBA Code:

    With tbl.DataBodyRange

    'First Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=datevalue(" & Chr(34) & CurrDate & Chr(34) & ")< INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(1).StopIfTrue = False
    .FormatConditions(1).Interior.Color = RGB(205, 5, 5)

Amapola · Sep 6, 2021

@Fluff Flawless, works a treat now. - Thank you heaps, @bobsan42 and @Fluff

I had promised to share the code once it works:

The macro now

converts the report to a table
applies conditional format to the rows
removes some unwanted columns
filters the table
Saves the file

VBA Code:

Sub zCalDueReport()
'
Dim shTable As Worksheet
Set shTable = Sheets("Table")
    
    Application.CutCopyMode = False
    
'Convert to Table
Dim tbl As ListObject
Dim src As Range
Set src = Range("A1").CurrentRegion
    ActiveSheet.ListObjects.Add(SourceType:=xlSrcRange, Source:=src, xlListObjectHasHeaders:=xlYes).Name = _
        "CalDue"
    Range("CalDue[#All]").Select
    ActiveSheet.ListObjects("CalDue").TableStyle = "TableStyleMedium1"
Set tbl = shTable.ListObjects("CalDue")

Dim sortcolumn As Range
Set sortcolumn = Range("CalDue[Calibration due]")
With tbl.Sort
   .SortFields.Clear
   .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
   .Header = xlYes
   .Apply
End With

'today's date for condition and file name
Dim CurrDate As Date
CurrDate = Date
Dim ReportDate As String
ReportDate = Format(Date, "yyyy-mm-dd")

'Delete any existing Conditional Formatting
tbl.DataBodyRange.FormatConditions.Delete


    With tbl.DataBodyRange

    'First Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=datevalue(" & Chr(34) & CurrDate & Chr(34) & ")> INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(1).StopIfTrue = False
    .FormatConditions(1).Interior.Color = RGB(205, 5, 5)
    
    'Second Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=datevalue(" & Chr(34) & CurrDate + 30 & Chr(34) & ")> INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(2).StopIfTrue = False
    .FormatConditions(2).Interior.Color = RGB(255, 155, 50)

    
    'Third Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=datevalue(" & Chr(34) & CurrDate + 90 & Chr(34) & ")> INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(3).StopIfTrue = False
    .FormatConditions(3).Interior.Color = RGB(250, 250, 5)
    
    'Fourth Rule
    .FormatConditions.Add Type:=xlExpression, Formula1:="=datevalue(" & Chr(34) & CurrDate + 180 & Chr(34) & ")> INDIRECT(""CalDue[@Calibration due]"")"
    .FormatConditions(4).StopIfTrue = False
    .FormatConditions(4).Interior.Color = RGB(50, 200, 200)
    
    End With
   

'Delete Column Tool type
tbl.ListColumns("Category").Delete
tbl.ListColumns("Purchase Cost").Delete


'Hide Items not calibrated
Dim iCol As Long
iCol = tbl.ListColumns("Status").Index
    tbl.DataBodyRange.AutoFilter Field:=iCol, Criteria1:="<>*not calibrated*"
          

'Save as report with month date
Dim ReportName As String
ReportName = "CalDueReport_" & ReportDate & ".xlsx"
ActiveWorkbook.SaveAs Filename:="C:\xxx\" & ReportName, FileFormat:=51

    
End Sub

bobsan42 · Sep 7, 2021

Amapola said:
@bobsan42 - Pretty sure that's what I'm doing so I don't think that's the error.

View attachment 46378

Maybe it was a typing error then but you just had an extra dot in your code:

Amapola said:
With tbl.DataBody.Range

However, now that it works, it's irrelevant

VBA Conditional Format List Object Table

Amapola

New Member

Excel Facts

bobsan42

Well-known Member

Amapola

New Member

bobsan42

Well-known Member

Amapola

New Member

bobsan42

Well-known Member

Amapola

New Member

Fluff

MrExcel MVP, Moderator

Amapola

New Member

bobsan42

Well-known Member

Similar threads

Forum statistics

Share this page

VBA Conditional Format List Object Table

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

MrExcel MVP, Moderator

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock