vba code to define conditions for conditional formatting

[mdd16]

Hello

I need help with a code that applies conditional formatting for 'all cells in selected range', having contents which meet following criteria

• Is Not Blank
• Is Not a Formula
• Is Not Text

Basically all non blank cells with content that is numbers

Can someone help please.
Thanks in advance.

 

[kevin9999]

You haven't said what format you want, but here's a demo on how to achieve some formatting on a selection of cells. Try it on a copy of your sheet.

Option Explicit
Sub Format_Selection()
    Dim r As String
    With Selection
        r = Replace(.Cells(1).Address, "$", "")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=AND(ISNUMBER(" & r & "),ISFORMULA(" & r & ")=FALSE)"
        .FormatConditions(1).Interior.Color = vbYellow
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

Before:

Book1
	G	H	I	J
4				5
5			Hello
6			2023
7	123123			AA
8
9		1
10			27/08/2023
11	1
Sheet1

Cell Formulas
Range	Formula
J4	J4	=H9*5
H9	H9	=1*1
I10	I10	=TODAY()

After:

Book1
	G	H	I	J
4				5
5			Hello
6			2023
7	123123			AA
8
9		1
10			27/08/2023
11	1
Sheet1

Cell Formulas
Range	Formula
J4	J4	=H9*5
H9	H9	=1*1
I10	I10	=TODAY()

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G4:J11	Expression	=AND(ISNUMBER(G4),ISFORMULA(G4)=FALSE)	text	NO

 

[mdd16]

Hello Kevin and thanks for your quick help.. your code works great.

However I have additional needs. I have created a user form with 2 option buttons. One to apply the conditional formatting and another remove those interior and font colors. But the removal code which used to work fine does not work now. I have attempted to remove the conditional formatting but it did not work. My code is given below;

Sub EntryCellOptions_Show()

Fm_EntryFormat_YN.OpBn_EntFmtApply_Sln.value = False
Fm_EntryFormat_YN.OpBn_EntFmtRmv_Sln.value = False
Fm_EntryFormat_YN.Show

End Sub
Sub eFmt_Selection()
    Dim r As String
    With Selection
        r = Replace(.Cells(1).Address, "$", "")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=AND(ISNUMBER(" & r & "),ISFORMULA(" & r & ")=FALSE)"
        .FormatConditions(1).Interior.Color = RGB(255, 255, 224)
        .FormatConditions(1).Font.Color = RGB(220, 20, 60)
        .FormatConditions(1).StopIfTrue = False

    End With
            
End Sub

Sub EntryCell_FmtErase_Sln()
Dim rCell As Range

    For Each rCell In Selection
        If rCell.Interior.Color = RGB(255, 255, 224) Then  'light yellow
            rCell.FormatConditions.Delete
            rCell.Interior.Color = RGB(255, 255, 255)      'no color
        End If
    Next rCell

      For Each rCell In Selection
        If rCell.Font.Color = RGB(220, 20, 60) Then  'red or crimson
            rCell.FormatConditions.Delete
            rCell.Font.Color = RGB(64, 64, 64) 'light black
        End If
    Next rCell

End Sub

 

[kevin9999]

Have you considered simply:

Sub EntryCell_FmtErase_Sln()
    With Selection
        .FormatConditions.Delete
    End With
End Sub

 

[mdd16]

Sub EntryCell_FmtErase_Sln() With Selection .FormatConditions.Delete End With End Sub

Thanks again Kevin.. this works.

However this will delete conditional formatting in all the cells whereas I wanted to reformat only those cells with my 'entry cell format'.

If you can further suggest something, will be nice.. but meanwhile I will implement what you suggest and keep looking for better solution..

Thanks again for your help mate..

 

[kevin9999]

In that case, try the following (simply reversing the use of the tests)

Sub EntryCell_FmtErase_Sln()
    Application.ScreenUpdating = False
    Dim rCell As Range
    For Each rCell In Selection
        If IsNumeric(rCell) And WorksheetFunction.IsFormula(rCell) = False Then
            rCell.FormatConditions.Delete
        End If
    Next rCell
    Application.ScreenUpdating = False
End Sub