I have conditional formatting and VBA to highlight active rows on a spreadsheet.
We use it on the next row to the one we're briefing because it changes the fill on the entire row.
Is there a way to ignore any cell that already has a fill color?
Current Conditional Formatting
=CELL("row")=ROW()
Current VBA
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Application.Calculate
End If
End Sub
I've only been able to highlight the entire active row.
You need a way to exclude cells which have any existing fill from passing the Conditional Formatting "highlight row" rule.
To do that you can add this UDF to a regular module:
'Return True if the calling cell has no fill
' Functions called from a CF rule formula have the
' calling cell as `Application.Caller`
Function NoFill() As Boolean
NoFill = (Application.Caller.Interior.ColorIndex = xlNone)
End Function
and add that to your CF rule formulas for row and column highlighting:
=AND(ROW()=CELL("row"),NoFill())
=AND(COLUMN()=CELL("col"),NoFill())
Example showing using the down arrow to step through rows (only using row highlighting CF rule):
Updated to add:
In a "real life" application using a larger range, this turned out to be unworkably slow - recalculating the worksheet to update the CF means every cell in the range with those rules has to be evaluated.
So here is something more scalable - it starts by deleting any pre-existing row/column-highlighting rules on the sheet, and then add rules only for the selected row/column, and only for cells with no fill:
In the worksheet module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
AddCFRules Target.Cells(1) 'in case of >1 cell selected
End If
End Sub
In a regular module:
Option Explicit
'called from Selection_change event handler
Sub AddCFRules(c As Range)
Const NUM_ROWS As Long = 1000 'adjust to suit...
Const NUM_COLS As Long = 500 'adjust to suit...
With c.Worksheet
RemoveRowColumnRules .Cells '#### changed to only delete some CF rules###
DoEvents
AddCFRule .Cells(c.row, 1).Resize(1, NUM_COLS) 'row highlight
AddCFRule .Cells(1, c.Column).Resize(NUM_ROWS, 1) 'column highlight
.Calculate
End With
End Sub
'add a rule to hilight a range
Sub AddCFRule(rng As Range)
Dim fc As FormatCondition, cfRange As Range
Set cfRange = UnFilledRange(rng) 'only unfilled cells
If Not cfRange Is Nothing Then 'any unfilled cells?
With cfRange.FormatConditions.Add(Type:=xlExpression, Formula1:="=TRUE")
.StopIfTrue = False
With .Interior
.PatternColorIndex = xlAutomatic
.Color = vbYellow
.TintAndShade = 0
End With
End With
End If
End Sub
'scan all cells in `rng` and return a Range with only unfilled cells
Function UnFilledRange(rng As Range) As Range
Dim c As Range
For Each c In rng
With c.Interior
If (.ColorIndex = xlNone Or .Color = vbWhite) Then
If UnFilledRange Is Nothing Then
Set UnFilledRange = c 'first cell
Else
Set UnFilledRange = Application.Union(UnFilledRange, c) 'all other cells
End If
End If
End With
Next c
End Function
'Delete any formula-based CF rules with "=TRUE" as the formula
'Allows other rules to be used on the sheet
Sub RemoveRowColumnRules(rng As Range)
Dim i As Long, fc As Object
'Debug.Print "checking CF rules:" & rng.FormatConditions.Count
For i = rng.FormatConditions.Count To 1 Step -1
Set fc = rng.FormatConditions(i)
If fc.Type = xlExpression Then
If fc.Formula1 = "=TRUE" Then fc.Delete
End If
Next i
End Sub
Having to exclude filled cells from the CF range is a bit awkward: ideally we'd add the same formula used in the first iteration, but for some reason it doesn't seem possible to create a CF rule in VBA using this formula. eg:
With someRange.FormatConditions.Add( _
Type:=xlExpression, _
Formula1:="=AND(ROW()=CELL(""row""),NoFill())")
fails with no error, and code execution stops at that point.
Using Formula1:="=ROW()=CELL(""row"")"
works as expected.
Later: I found that if you use a global variable eg
Dim skip as Boolean
and use that a flag to exit the UDF referenced by a CF formula:
Function NoFill() As Boolean
If skip Then Exit Function
NoFill = (Application.Caller.Interior.ColorIndex = xlNone)
End Function
then you can set skip
to True
when applying the CF rule via VBA, and it will successfully set up the rule without breaking. When done adding the rule(s), set skip
to False
.