In Excel how to replace cell interior color with two conditions

Question

In my Excel sheet, First condition is to Highlight the intersected cell with BLUE based on text matching of row and column.

Second condition: The cell values which are highlighted in Blue must Change to red if the cell value(date Format) is less than today's date.

I am able to fulfill first condition but failing to satisfy second condition.

The Excel data Looks like below:

First Condition:

Second Condition:Problem I am facing to get red interior

I am trying with a VBA Code as below:

Sub RunCompare()

    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim cols As Range, rws As Range
    Dim lastRow As Integer: lastRow = ws.UsedRange.Rows.Count
    Dim lastColumn As Integer: lastColumn = ws.UsedRange.Columns.Count
  
    For Each cols In ws.Range(ws.Cells(4, 1), ws.Cells(4, lastColumn))
        If cols.Value <> vbNullString Then
            For Each rws In ws.Range("A1:A" & lastRow)
                'first condition statement
                If (rws.Value = cols.Value) Then 
                ws.Cells(rws.Row, cols.Column).Interior.Color = RGB(15, 219, 241)
                End If
                
                'second condition statement
                If (rws.Value = cols.Value) < Date Then           
                ws.Cells(rws.Row, cols.Column).Interior.Color = RGB(255, 0, 0)
                End If
            Next   
        End If
    Next
    
End Sub

You can do this with conditional formatting. Is VBA necessary? — BigBen, Nov 01 '19 at 12:08
May be but I have other linked Sheets based on this Output so I preferred writing in VBA. — sant, Nov 01 '19 at 12:11
Your 2nd condition isn't working because `rws` and `cols` aren't the cells you want to be looking at. You want to look at `ws.Cells(rws.Row, cols.Column)` - that is the cell with the value you want to check. Note: `(rws.Value = cols.Value) < Date` won't work, because the left side evaluates to True/False, so you're trying to do `True < Date`. — BigBen, Nov 01 '19 at 12:16
`If ws.Cells(rws.Row, cols.Column).Value < Date Then`... but I wouldn't do it like this to be honest. — BigBen, Nov 01 '19 at 12:32
Note - use `Long` instead of `Integer`. And see [this question](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) for a robust way to find the last row/column. `UsedRange` has issues. — BigBen, Nov 01 '19 at 12:33
or only for second condition how I can use conditional formatting? — sant, Nov 01 '19 at 12:56
is it possible to replace "B2" with a generic based on Cell interior Color like "Blue" — sant, Nov 01 '19 at 13:31
No. Are you saying that the column header and row header also have to match for the red to be applied? — BigBen, Nov 01 '19 at 13:32
Yes, column header and row Header to match and when the cell value is less than Today only then the cell Color to be changed to RED or else BLUE. — sant, Nov 01 '19 at 13:40

BigBen · Accepted Answer · 2019-11-01T13:54:42.807

This can easily be done with conditional formatting.

Add two rules based on these formulas:

RED: =AND($A3=B$1,B3<>"",B3<TODAY()).
BLUE: =AND($A3=B$1,B3<>"")

If you really want to keep your current VBA, you could change

If (rws.Value = cols.Value) < Date Then

to

If (rws.Value = cols.Value) And (ws.Cells(rws.Row, cols.Column).Value < Date) Then

Or you could simplify further, by moving the RED condition inside the existing BLUE condition check (rws.Value = cols.Value must be true for both red and blue.)

If rws.Value = cols.Value Then
    With ws.Cells(rws.Row, cols.Column) 
        If .Value < Date Then
            .Interior.Color = RGB(255, 0, 0) ' RED
        Else 
            .Interior.Color = RGB(15, 219, 241) ' BLUE
        End If
    End With
End If

score 0 · Answer 2 · answered Nov 01 '19 at 14:15

Is this solution OK for you?

Dim ws As Worksheet

Dim col As Integer
Dim row As Integer
Dim lastRow As Integer
Dim lastCol As Integer
Dim OK As Boolean

Set ws = ActiveSheet
lastRow = ws.UsedRange.Rows.Count
lastCol = ws.UsedRange.Columns.Count

For col = 1 To lastCol
    For row = 2 To lastRow
        If ws.Cells(row, 1).Value = ws.Cells(1, col).Value Then
            If ws.Cells(row, col) < Date Then
                ws.Cells(row, col).Interior.Color = RGB(255, 0, 0)
            Else
                ws.Cells(row, col).Interior.Color = RGB(15, 219, 241)
            End If
        End If
    Next
Next

In Excel how to replace cell interior color with two conditions

2 Answers2