Check If not IsNumeric

[micko1]

Trying to get a macro to check if cells A1-A65536 contain text. If so then place a formula in coresponding row column "O" Formula is =IF(OR(F7<=TODAY(),G7<=TODAY(),H7<=TODAY()),"NonCompliant","Compliant")
Thanks in advance.

Mick

 

[ZVI]

Hi Mick,
Try:

Sub Test()
  Dim Rng As Range, a, v, r&
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  a = Rng.Value
  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[-9]:RC[-7])<=TODAY(),""NonCompliant"",""Compliant"")"
      End If
    End If
  Next
  Rng.Columns("O").Value = a
End Sub

Regards

 

[ZVI]

The code above clears previous values of column O and then sets the formula.
If preserving of values in Column O is required for not text values of Column A, then try this modification:

' Preserve old contents of Column O
Sub Test1()
  Dim Rng As Range, a, b, v, r&
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  a = Rng.Value
  b = Rng.Columns("O").Value
  For r = 1 To UBound(a)
    v = a(r, 1)
    If VarType(v) = vbString Then
      If Len(v) > 0 Then
        b(r, 1) = "=IF(MIN(RC[-9]:RC[-7])<=TODAY(),""NonCompliant"",""Compliant"")"
      End If
    End If
  Next
  Rng.Columns("O").Value = b
End Sub

 

[micko1]

Thankyou very much this works excellent. Could I just ask another question, not sure if you can help. I have conditionaly formated columns "F","G"and "H" from row 7 to last cell used. the formating is as follows.
=$F7<=TODAY()
=AND($F7>TODAY(),$F7<TODAY()+7)
=AND($G7>TODAY(),$G7<TODAY()+30)
Is it possible to add this to the macro to place the formating in the same rows.
eg:-if row 135 has text, it then places the formula in column "O" as per the code above, and then also conditionaly formats column "F","G"and "H"

Thanks heaps again for the assistance so far.

Mick

 

[ZVI]

Sorry, but your CFs formulas are unclear, nonclosed brackets are in it.
Please switch on macrorecorder, manually set CFs for F7,G7, H7 cells.
Then stop macrorecorder and post the written code.

 

[micko1]

Took a while to get it right but here it is. I have only selected the first 20 rows to get this result.
In reply to your second response, No I do not need to preserve any values in Column ("O")
Thanks once agin for your assistance.
Hope this is enough info.

Mick

Sub Macro5()
'
' Macro5 Macro
'
' Keyboard Shortcut: Ctrl+d
'
Range("F7:H20").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F7<=TODAY()"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($F7>TODAY(),$F7<TODAY()+7)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($F7>TODAY(),$F7<TODAY()+30)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

 

[ZVI]

Ok, I've found your conditions using of quotation of your post #4.
At posting use space char before & after condition operators for correct viewing in this Board.

Below is the updated version for setting CFs to H:G columns starting from the 7th row.

Change CF's formulas and formattings in the code as required.

Sub Test2()
  
  Dim Rng As Range, a, v, r&
  
  ' Set range of values in Column A
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set Rng = .Range("A1", .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[-9]:RC[-7])<=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("O").Value = a
    ' Set CFs to F:H range
    SetCF .Range("F:H").Resize(UBound(a) - 6).Offset(6)
  End With
  
End Sub


Private Sub SetCF(Rng As Range)
  
  ' Conditional formulas in R1C1 format, change to suit
  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))"
  
  With Rng
    With .FormatConditions
      ' Delete CFs
      .Delete
      ' Add CF #1
      With .Add(Type:=xlExpression, Formula1:=Fm1)
        .Borders.LineStyle = xlContinuous
        .Interior.ColorIndex = 35 ' <-- Change to suit
      End With
      ' Add CF #2
      With .Add(Type:=xlExpression, Formula1:=Fm2)
        .Borders.LineStyle = xlContinuous
        .Interior.ColorIndex = 36 ' <-- Change to suit
      End With
      ' Add CF #3
      With .Add(Type:=xlExpression, Formula1:=Fm3)
        .Borders.LineStyle = xlContinuous
        .Interior.ColorIndex = 40 ' <-- Change to suit
      End With
    End With
  End With

End Sub

 

[ZVI]

Seems the constants in SetCF for your formulas should be as follows:

  Const Fm1$ = "=IF(ISTEXT(RC1),RC6 <= TODAY())"
  Const Fm2$ = "=IF(ISTEXT(RC1),AND(RC6 > TODAY(),RC6 < TODAY()+7))"
  Const Fm3$ = "=IF(ISTEXT(RC1),AND(RC6 > TODAY(),RC6 < TODAY()+30))"

Where RC6 is $F7 in R1C1 notation

 

[micko1]

I can't thank you enough for the assistance. Does what I want but places "Compliant or NonCompliant" in Column "O" rows 1 to 6 as well, only need it to check from row 7. I have tried editing your code but not smart enough to work it out.


Thanks Mick

 

[mole999]

if your not using data up in A1 then maybe

Set Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))

doesn't suit your need

maybe

Set Rng = .Range("A<font color = red>7</font>", .Cells(.Rows.Count, 1).End(xlUp))

is the only change necessary