preventing data entry if one cell's value smaller then zero

[taco]

Hi everyone;

On my worksheet, users can enter data on E6:J185 range. and C3 cell is
counting down from 4.500 the total entered amount. What I would like to do
is, while users are entering data, if C3's value is getting smaller than
zero, code should warn them and prevent further data entry. Here is my
unsuccesful code;
Dim OldValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If (c3) < 0 Then
On Error GoTo Whoops
Application.EnableEvents = False
MsgBox "You Don’t Have Enough Points!"
Target.Value = OldValue
End If
Whoops:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (c3) < 0 Then OldValue = Target.Value
End Sub

Thanks a lot in advance for your time and help.

Regards.

 

[OssieMac]

Try creating another worksheet to save the old values at a corresponding cell
address if the entry is valid and if the target is not valid then copy the
old value back to the Target. Something like the following example:-


Private Sub Worksheet_Change(ByVal Target As Range)
Dim strAddress As String

'Save the address of Target
strAddress = Target.Address

If Range("C3") >= 0 Then
'Target entry OK so
'Save the entered value in Sheets("OldValue") at
'address matching main worksheet
Sheets("OldValues").Range(strAddress) = Target.Value
Else
MsgBox "You Don’t Have Enough Points!"
'Copy the previously saved value for the address to target
Target.Value = Sheets("OldValues").Range(strAddress)
End If


End Sub

 

[Norman Jones]

Hi Taco,

Try:

'==========>>
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim Rng2 As Range

With Me
Set Rng = .Range("E6:J185")
Set Rng2 = .Range("C3")
End With

If Not Intersect(Rng, Target) Is Nothing Then
If Rng2.Value <= 0 Then
On Error GoTo 0
Application.EnableEvents = False
MsgBox "You Don’t Have Enough Points!"
Application.Undo
End If
End If
Whoops:
Application.EnableEvents = True
End Sub
'<<==========

 

[Norman Jones]

Hi Taco,

On Error GoTo 0

Should read:

On Error GoTo Whoops

 

[taco]

Hi Norman;

Thank you very much. I really appreciated. It's works perfectly.

 

[taco]

Thanks a lot OssieMac. Appreciated.

Try creating another worksheet to save the old values at a corresponding cell
address if the entry is valid and if the target is not valid then copy the
old value back to the Target. Something like the following example:-


Private Sub Worksheet_Change(ByVal Target As Range)
Dim strAddress As String

'Save the address of Target
strAddress = Target.Address

If Range("C3") >= 0 Then
'Target entry OK so
'Save the entered value in Sheets("OldValue") at
'address matching main worksheet
Sheets("OldValues").Range(strAddress) = Target.Value
Else
MsgBox "You Don’t Have Enough Points!"
'Copy the previously saved value for the address to target
Target.Value = Sheets("OldValues").Range(strAddress)
End If


End Sub