Highlight cells without a formula

[scotthannaford1973]

Hi all

I have a sheet with 100 or so rows in - and every row has the same formulas; as I have staff who aren't great on Excel, they sometimes delete formulas or insert rows (and then don't add in the formulas). I'd like to add in some VB that will, for example, look at range A1:100 and highlight any cells that don't have a formula in. They may have data or conditional formatting, but by clicking on a button to run the module I want to show the cells where there are no formulas. Is that possible?

TIA

 

[James006]

Hi,

Do you mean you would need a UDF

Function isFormula(ByVal target As Range) As Boolean
     isFormula = target.hasFormula
End Function

or run a macro with the same approach to change the format of each cell which .HasFormula ...

 

[James006]

For the test macro ...

Sub Test()
Dim c As Range
For Each c In Selection
    If c.HasFormula = True Then
      c.Interior.Color = vbYellow
    End If
Next c
End Sub

 

[Sufiyan97]

Hi James,

Sorry for intrupting

Macro works fine but running very slow
also can we add a condition so that when formula is added and we run macro again then it selects No fill for those new added formulas.

 

[James006]

Hi,
Revised macro for speed ...

Sub Test()
Dim c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In Selection
    If c.HasFormula = True And Not (c.Interior.Color = vbYellow) Then
      c.Interior.Color = vbYellow
    End If
Next c
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Georgiboy]

Maybe you could play with something like below, it will apply the format all at once when it has built a range from finding blanks or constants within the given range - A1:A100 in this case:

Sub test()
    Dim rng As Range, bRng As Range, fRng As Range, uRng As Range
    
    Set rng = Range("A1:A100")
    
    On Error Resume Next
    Set bRng = rng.SpecialCells(xlCellTypeBlanks) ' blanks
    Set fRng = rng.SpecialCells(xlCellTypeConstants) ' constants
    On Error GoTo 0
    
    If bRng Is Nothing And fRng Is Nothing Then
        Exit Sub
    ElseIf Not bRng Is Nothing And Not fRng Is Nothing Then
        Set uRng = Union(bRng, fRng)
    ElseIf Not bRng Is Nothing Then
        Set uRng = bRng
    ElseIf Not fRng Is Nothing Then
        Set uRng = fRng
    End If
    
    uRng.Interior.Color = vbYellow
End Sub

 

[Sufiyan97]

Hi,
Revised macro for speed ...

Sub Test()
Dim c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In Selection
    If c.HasFormula = True And Not (c.Interior.Color = vbYellow) Then
      c.Interior.Color = vbYellow
    End If
Next c
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Thank you James,
Working perfect.
I found the reason why it was running slow, becuase I was selecting entire column.

 

[James006]

Thank you James,
Working perfect.
I found the reason why it was running slow, because I was selecting entire column.

Glad to hear you could fix your problem

 

[Sufiyan97]

Maybe you could play with something like below, it will apply the format all at once when it has built a range from finding blanks or constants within the given range - A1:A100 in this case:

Sub test()
    Dim rng As Range, bRng As Range, fRng As Range, uRng As Range
   
    Set rng = Range("A1:A100")
   
    On Error Resume Next
    Set bRng = rng.SpecialCells(xlCellTypeBlanks) ' blanks
    Set fRng = rng.SpecialCells(xlCellTypeConstants) ' constants
    On Error GoTo 0
   
    If bRng Is Nothing And fRng Is Nothing Then
        Exit Sub
    ElseIf Not bRng Is Nothing And Not fRng Is Nothing Then
        Set uRng = Union(bRng, fRng)
    ElseIf Not bRng Is Nothing Then
        Set uRng = bRng
    ElseIf Not fRng Is Nothing Then
        Set uRng = fRng
    End If
   
    uRng.Interior.Color = vbYellow
End Sub

Thanks for the reply Georgyboy, I have changed range to B1:B100

Not working, by the way James's code works so no need to modify the code, just wanted to let you know.

Book2
	A	B	C	D
1		0
2		0
3		0
4		0
5		0
6		0
7		0
8		0
9		0
10		0
11		0
12
13
14		0
15		0
16
17
18		0
19
Sheet1

Cell Formulas
Range	Formula
B1:B11,B18,B14:B15	B1	=A1-C1

 

[Sufiyan97]

Glad to hear you could fix your problem

The final code looks like

Sub test()
Dim c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In Selection
    If c.HasFormula = True Then
      c.Interior.Color = vbYellow
      Else
      c.Interior.Color = xlNone
    End If
Next c
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub