Help with Excel Macro to Conditional format Cells

[micko1]

Need help with Macro that conditionaly formats cells dependant on date. What I need is for the formula to ignor blank cells. At the moment it colours the cells red if they are empty. Tried
=IF(RC="","",IF(ISTEXT(RC1),RC <= TODAY()))"
But no luck
Any help would be greatly appreciated.

Mick

 Sub Test_Staff_Vehicles()
  Dim rng As Range, a, v, r&
  Application.ScreenUpdating = False
    Application.DisplayAlerts = False
  ' Set range of values in Column A
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set rng = .Range("A7", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  
  ' Copy Rng values to  a() to speed up processing
  a = rng.Value
  
  ' Analyze each value of a(), empty it or put formula into it
  For r = 1 To UBound(a)
    v = a(r, 1)
    a(r, 1) = Empty
    If VarType(v) = vbString Then
      If Len(v) > 0 Then
        a(r, 1) = "=IF(MIN(RC[-15],RC[-13],RC[-11],RC[-10])<=TODAY(),""NonCompliant"",""Compliant"")"
      End If
    End If
  Next
  
  ' Put formulas and CFs to the destination ranges
  With rng
    ' Copy a() to the destination column O
    .Columns("T").Value = a
    ' Set CFs to F:H range
    SetCF .Columns("E")
    SetCF .Columns("G")
    SetCF .Columns("I")
    SetCF .Columns("J")
  End With
  
End Sub

Private Sub SetCF(rng As Range)
  
  ' Conditional formulas in R1C1 format, change to suit
  [COLOR=red]Const Fm1$ = "=IF(ISTEXT(RC1),RC <= TODAY())"
  Const Fm2$ = "=IF(ISTEXT(RC1),AND(RC > TODAY(),RC < TODAY()+7))"
  Const Fm3$ = "=IF(ISTEXT(RC1),AND(RC > TODAY(),RC < TODAY()+30))"
[/COLOR]  
  With rng
    With .FormatConditions
      ' Delete CFs
      .Delete
      ' Add CF #1
      With .Add(Type:=xlExpression, Formula1:=Fm1)
        .Borders.LineStyle = xlContinuous
        .Interior.ColorIndex = 3 ' <-- Change to suit
      End With
      ' Add CF #2
      With .Add(Type:=xlExpression, Formula1:=Fm2)
        .Borders.LineStyle = xlContinuous
        .Interior.ColorIndex = 7 ' <-- Change to suit
      End With
      ' Add CF #3
      With .Add(Type:=xlExpression, Formula1:=Fm3)
        .Borders.LineStyle = xlContinuous
        .Interior.ColorIndex = 4 ' <-- Change to suit
      End With
    End With
  End With
Sheets("Staff & Vehicles").Select
 Sheets("Staff & Vehicles").Activate
 
 
End Sub

 

[careywalker]

I think I understand what you macro is trying to do. What if you added an IsEmpty check to your Len check as in...


If Len(v) > 0 Then AND Not IsEmpty(v)

a(r,1)="=IF(MIN(RC[-15],RC[-13],RC[-11],RC[-10])=TODAY(),""NonCompliant"",""Compliant"")"
​

End If

 

[micko1]

Thanks for the reply but no good, Syntax was wrong.
I played around with the line that sets the "CF" and came up with this formula that appears to work.
Thanks heaps anyway, realy appreciate your input.
Mick

[/COLOR]
Private Sub SetCF(rng As Range)
' Conditional formulas in R1C1 format, change to suit
[COLOR=blue][/COLOR] 
[COLOR=blue]'Replaced this line[/COLOR]
[COLOR=red]  Const Fm1$ = "=IF(ISTEXT(RC1),RC <= TODAY())"[/COLOR]
[COLOR=blue]'With this Line[/COLOR]
[COLOR=red]  Const FM1$ = "=IF(RC<=0,"""",IF(ISTEXT(RC1),RC <= TODAY()))"[/COLOR]
[COLOR=red][COLOR=red]  Const Fm2$ = "=IF(ISTEXT(RC1),AND(RC > TODAY(),RC < TODAY()+7))"
  Const Fm3$ = "=IF(ISTEXT(RC1),AND(RC > TODAY(),RC < TODAY()+30))"
[/COLOR][/COLOR]
[COLOR=red]