Using VBA to apply conditional formatting based on above cell value

[samjsteffes]

Hi all,

I have a question about adding conditional formatting with VBA, and I am hoping someone can nudge me in the right direction....

Context/scenario:

I have a multidimensional table of different fields, which is used to track where physical attributes change at certain footage. As an example:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Footage[/TD]
[TD]Structure[/TD]
[TD]Material[/TD]
[TD]Clip type[/TD]
[TD]Access[/TD]
[/TR]
[TR]
[TD]0[/TD]
[TD]at grade[/TD]
[TD]wood[/TD]
[TD]plastic[/TD]
[TD]Normal[/TD]
[/TR]
[TR]
[TD]100[/TD]
[TD]at grade[/TD]
[TD]wood[/TD]
[TD]plastic[/TD]
[TD]Narrow[/TD]
[/TR]
[TR]
[TD]250[/TD]
[TD]elevated[/TD]
[TD]wood[/TD]
[TD]plastic[/TD]
[TD]Narrow[/TD]
[/TR]
[TR]
[TD]300[/TD]
[TD]elevated[/TD]
[TD]concrete[/TD]
[TD]plastic[/TD]
[TD]Narrow[/TD]
[/TR]
[TR]
[TD]375[/TD]
[TD]elevated[/TD]
[TD]concrete[/TD]
[TD]plastic[/TD]
[TD]Restricted[/TD]
[/TR]
[TR]
[TD]525[/TD]
[TD]elevated[/TD]
[TD]steel[/TD]
[TD]plastic[/TD]
[TD]Restricted[/TD]
[/TR]
[TR]
[TD]615[/TD]
[TD]at grade[/TD]
[TD]steel[/TD]
[TD]composite[/TD]
[TD]Narrow[/TD]
[/TR]
[TR]
[TD]800[/TD]
[TD]at grade[/TD]
[TD]wood[/TD]
[TD]plastic[/TD]
[TD]Narrow[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]at grade[/TD]
[TD]wood[/TD]
[TD]plastic[/TD]
[TD]normal[/TD]
[/TR]
</tbody>[/TABLE]

I've changed the actual content from what I am working with, but the key detail is that each row entry is created because an attribute in at least one of the fields changed at that footage; I've highlighted these occurrences in the table above.

What I would like to do, is create a macro in order to toggle on/off conditional formatting to highlighted these changes, preferably by highlighting the cells, rather than changing the text color.

Some other notes: I'm using a structured table reference, and I only want to apply this formatting to a specified group of the table columns

Below is the code I've tried:

sub hilite_cells()

dim tbl as ListObject
dim rng as Range
dim a as Integer
dim b as Integer
dim i as Integer

Application.ScreenUpdating = False

On Error Resume Next
Set tbl = Worksheets("sheet_name").ListObjects("tbl_name")
Set rng = tbl.HeaderRowRange
If tbl Is Nothing Or rng Is Nothing Then
    MsgBox "Nothing found."
    Exit Sub
End If

tbl.DataBodyRange.FormatConditions.Delete
For i = a To b
    With tbl.ListColumns(i).DataBodyRange.Offset(1, 0).Resize(tbl.DataBodyRange.Rows.count - 1)
    .FormatConditions.Add Type:=xlExpression, Formula1:="<>" & .Offset(1, 0).Value
    .FormatConditions(1).Interior.Color = vbYellow
    End With
Next i


Application.ScreenUpdating = True


End Sub

The bold line in the code is the one I can't figure out. In a 'with' procedure, how do I get it to look at the address/value of the cell above to compare? I'm trying to avoid to a "for each" type loop through all the cells, since the table could become pretty large. This code doesn't result in any errors, but it also doesn't result in any new conditional formatting rules being applied, so I assume something is off.

I'd also be curious to know if there is a way to do this without having "live" conditional formatting as the end result. Meaning, can I just review the table columns and highlight based on this condition/criteria, without having to apply conditional formatting?


Thanks in advance for any advice!

- sjs

 

[samjsteffes]

Hi,

Figured I would post an update on my progress, in case anyone is following at home and/or was as curious (see: stumped) as I was.

Sub Hilite_Changes()


Dim tbl As ListObject
Dim rng As Range
Dim frng As Range
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim c As Range


Application.ScreenUpdating = False


On Error Resume Next
Set tbl = Worksheets("sheet_name").ListObjects("tbl_name")
Set rng = tbl.HeaderRowRange
If tbl Is Nothing Or rng Is Nothing Then
    MsgBox "A table cannot be located. Please review the Macro code and table names for errors."
    Exit Sub
End If

'index the position of the start/end columns between which conditional formatting will be applied
a = WorksheetFunction.Match("Horizontal Alignment", rng, False)
b = WorksheetFunction.Match("Access", rng, False)

'delete any existing conditional formatting or static fill/shading
tbl.DataBodyRange.FormatConditions.Delete
tbl.DataBodyRange.Interior.Color = xlNone


For i = a To b
    Set frng = tbl.ListColumns(i).DataBodyRange.Offset(1, 0).Resize(tbl.DataBodyRange.Rows.count - 1)
'the offset step above adjusts the range so that the first cell is not highlighted when it is inevitably different than the column header
    With frng
        .FormatConditions.Add Type:=xlExpression, Formula1:="=R[-1]C[0]<>R[0]C[0]"
        .FormatConditions(1).Interior.Color = vbYellow
'steps to keep formatting but removed CF rules
        For Each c In frng
            c.Interior.Color = c.DisplayFormat.Interior.Color
        Next c
        .FormatConditions.Delete
    End With
Next i


Application.ScreenUpdating = True


End Sub

As you can see, I figured out the formula required to highlight "changes" as desired. I then wanted to convert the formatting to "static" so that I wouldn't have a lot of dynamic CF rules that could get corrupted or shifted (ultimately, I just want to toggle this formatting on/off temporarily, so it probably wouldn't matter, but I was conscious of how slow a file can become if there is a lot of condition formatting applied over a large range). I ran into some difficulty here, but ended up learning something new about conditional formatting: you can't copy only the displayed format and leave behind the rules because, from what I gather, conditional formatting doesn't actually become an attribute of the cell (??).

I initially tried doing the following without the for loop, but that didn't work as expected.

.interior.color = .displayformat.interior.color

The result was that the entire column was filled in black (so I couldn't see the text)... not exactly sure why this was the outcome, but I imagine it has to do with the range on which the command is actually being executed when only within the 'with' loop. All the examples (and there are many) of dropping conditional formatting to static formatting that I found online included some step through each cell in the range to copy the display formatting, so it seems there is no other way...

In the end, it works as needed, but I ended up needing a for loop after all (if anyone out there watching says otherwise, I am all ears). As such, I can probably re-write the code to avoid using conditional formatting at all, and just step through each cell in the range, changing the color if the value doesn't match the value above. But in the interest of shared learning, I came up a possible solution to this approach.


/ramble


-sjs