highlight cells which are not based on a formula

[robertvdb]

I have a range (col D) which is based on a formula. However, the user can "override" this formula by entering the correct values, instead of calculating.

See enclosed (simplified) example.

How can I (VBA) highlight the cells which are being entered manually ?

Thanks

 

[awoohaw]

This is a test for if a formula is in the cell. But, why do you want the user to delete the formula? The formula will be removed.

=ISFORMULA(D4)

 

[Peter_SSs]

This is a test for if a formula is in the cell.

=ISFORMULA(D4)

.. but would not available to the OP if their profile is correct (Excel 2010)

 

[robertvdb]

Thanks Awoohaw

so in VBA this would be:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim kol_D_rng As Range

Set kol_D_rng = Range("D2:D4")

If Not Application.Intersect(Target, kol_D_rng) Is Nothing Then
    If Target.HasFormula = False Then
        Target.Interior.Color = RGB(200, 200, 200)  'or some other RGB
    Else
    End If
End If

end sub

I needed this because I have some 1000 lines in column D, and the user must have the possibility of manually entering the value, instead of calculating it.

As I said, the initial example was very simplified, in reality the formula is much more complicated, and the entering of non-calculated results must remain possible.

Thanks again.

 

[Peter_SSs]

I would suggest a few changes. Some of these things may be unlikely but, using my sample sheet below,

• If the user enters a constant and then decides to put/copy the formula back in, your code will leave the cell coloured.
• If the user decides to paste 11 in D3 but accidentally selects D3 & E3 before pasting, both D3 and E3 will get coloured (& removing the 11 from E3 would not remove the colour from that cell)

robertvdb.xlsm
	A	B	C	D	E
1
2	5	5		10
3	3	8		11
4	10	1		11
5
Sheet1

Cell Formulas
Range	Formula
D2:D4	D2	=A2+B2

This would be my suggestion for an alternative.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim kol_D_rng As Range, kol_D_formulas As Range
  
  Set kol_D_rng = Range("D2:D4")
  If Not Intersect(Target, kol_D_rng) Is Nothing Then
    Application.ScreenUpdating = False
    kol_D_rng.Interior.Color = RGB(200, 200, 200)
    On Error Resume Next
    Set kol_D_formulas = kol_D_rng.SpecialCells(xlFormulas)
    On Error GoTo 0
    If Not kol_D_formulas Is Nothing Then kol_D_formulas.Interior.ColorIndex = xlNone
    Application.ScreenUpdating = True
  End If
End Sub

 

[robertvdb]

Thanks Peter

I'll have a look. Might be a useful amendment of the code.