Check If not IsNumeric

micko1

Board Regular
Joined
Feb 10, 2010
Messages
80
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
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Hi Mick,
Try:
Rich (BB code):

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
 
Last edited:

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
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:
Rich (BB code):

' 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

Board Regular
Joined
Feb 10, 2010
Messages
80
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

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

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.
 
Last edited:

micko1

Board Regular
Joined
Feb 10, 2010
Messages
80
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

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

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.
Rich (BB code):

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
 
Last edited:

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,805
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
Seems the constants in SetCF for your formulas should be as follows:
Rich (BB code):

  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
 
Last edited:

micko1

Board Regular
Joined
Feb 10, 2010
Messages
80
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

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,383
Messages
5,601,318
Members
414,441
Latest member
KellyTheKid

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top