Promt before changing a value

  • Thread starter Thread starter Mangler
  • Start date Start date
M

Mangler

I was asked the below question by someone and was wondering if you
guys have any advise I can relay to him.

"I am looking to create something, most likely with VB code, in excel
that will pop up a dialog box to warn the user that they are changing
the quantity of a part by a more than normal amount. For example, if
the current inventory quantity for a specific insert is 10,000, then
if that cell is changed by more than 3000, a dialog box will appear to
prompt the user to double check their change. So, if that cell is
changed to 13,000 or higher, or, 7,000 or lower, the dialog box will
warn the user. The code will be referencing not another cell, but
what the cell quantity was before the change compared to what the cell
quantity was changed to.

Any ideas?"
 
You could do that with Data Validation

Set number minimum at 7001 and maximum at 12999


Gord Dibben MS Excel MVP
 
You could do that with Data Validation

Set number minimum at 7001 and maximum at 12999

Gord Dibben  MS Excel MVP





- Show quoted text -
Click to expand...

I see how that works now thanks! Next question on the same subject,
what if there is lots of data in a column and I wanted to warn the
user only when they are changing the value by 3000. So if they made
an edit to a cell but the change was less then +-3000 they wont get
the message but if they changed the value to by more then 3000 they
would get the prompt.
 
Right-click the sheet tab, enter this:

Public Amt

Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Target.Value) Then
If Abs(Target.Value - Amt) / Amt > 0.3 Then MsgBox "Changed by " &
Format(Abs(Target.Value - Amt) / Amt, "0.0%") & " - was " & Amt
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Amt = Target.Value
If Amt = 0 Then Amt = 1
End Sub
 
Right-click the sheet tab, enter this:

Public Amt

Private Sub Worksheet_Change(ByVal Target As Range)
    If IsNumeric(Target.Value) Then
        If Abs(Target.Value - Amt) / Amt > 0.3 Then MsgBox "Changed by " &
Format(Abs(Target.Value - Amt) / Amt, "0.0%") & "  - was " & Amt
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Amt = Target.Value
    If Amt = 0 Then Amt = 1
End Sub








- Show quoted text -
Click to expand...

Right clicked the sheet, view code and entered that but when i make a
change in a cell i am getting this error :

Compile error:
syntax error

and this line is highlighted in the debugger:

Private Sub Worksheet_Change(ByVal Target As Range)
 
Bob Umlas said:
Public Amt

Private Sub Worksheet_Change(ByVal Target As Range)
Click to expand...
....

VBA variables aren't persistent. If anything in any module throws a
runtime error, all global and local static variables are reset. This
is a fragile approach. Then there's the pickier matter of declaring
Amt Public, so global scope, rather than Private, so module scope. And
also the runtime errors that would occur when users enter numeric
values into cells that had previously been nonnumeric; IOW, your code
checks the new value's type but not the previous value's type.

If the cell in question should revert to the previous value if the
user doesn't confirm entering a value outside the swing range, this
can be done without storing the previous value in a global variable.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, t As Variant, ac As Variant
Dim i As Long, j As Long, k As Long, tac As Long

On Error GoTo CleanUp
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Application.ScreenUpdating = False
ac = Application.Calculation
Application.Calculation = xlCalculationManual

tac = Target.Areas.Count
ReDim v(1 To tac)

For k = 1 To tac
v(k) = Target.Areas(k).Value2

If Not IsArray(v(k)) Then
ReDim t(1 To 1, 1 To 1)
t(1, 1) = v(k)
v(k) = t
Erase t
End If

Next k

Application.Undo

For k = 1 To tac
With Target.Areas(k)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count

If VarType(.Cells(i, j).Value2) = vbDouble Then 'was numeric

If VarType(v(k)(i, j)) = vbDouble Then 'still numeric

If Abs(v(k)(i, j) / .Cells(i, j).Value2 - 1) >= 0.3 Then

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" differs from previous value " & .Cells(i, j).Value2
& _
" by more than 30%." & vbLf & _
"Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0),
_
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

Else
.Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'no longer numeric

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" is nonnumeric but previous value " & .Cells(i,
j).Value2 & _
" was numeric." & vbLf & "Do you want to make this
change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'wasn't numeric, so any & all changes accepted
.Cells(i, j).Value2 = v(k)(i, j)

End If

Next j
Next i
End With
Next k

CleanUp:
Application.Calculation = ac
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.EnableCancelKey = xlInterrupt

End Sub


Better still would be intersecting Target with a named range outside
which this check need not be made.
 
...



...

VBA variables aren't persistent. If anything in any module throws a
runtime error, all global and local static variables are reset. This
is a fragile approach. Then there's the pickier matter of declaring
Amt Public, so global scope, rather than Private, so module scope. And
also the runtime errors that would occur when users enter numeric
values into cells that had previously been nonnumeric; IOW, your code
checks the new value's type but not the previous value's type.

If the cell in question should revert to the previous value if the
user doesn't confirm entering a value outside the swing range, this
can be done without storing the previous value in a global variable.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim v As Variant, t As Variant, ac As Variant
  Dim i As Long, j As Long, k As Long, tac As Long

  On Error GoTo CleanUp
  Application.EnableCancelKey = xlDisabled
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  ac = Application.Calculation
  Application.Calculation = xlCalculationManual

  tac = Target.Areas.Count
  ReDim v(1 To tac)

  For k = 1 To tac
    v(k) = Target.Areas(k).Value2

    If Not IsArray(v(k)) Then
      ReDim t(1 To 1, 1 To 1)
      t(1, 1) = v(k)
      v(k) = t
      Erase t
    End If

  Next k

  Application.Undo

  For k = 1 To tac
    With Target.Areas(k)
      For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count

          If VarType(.Cells(i, j).Value2) = vbDouble Then 'was numeric

            If VarType(v(k)(i, j)) = vbDouble Then 'still numeric

              If Abs(v(k)(i, j) / .Cells(i, j).Value2 - 1) >= 0.3 Then

                If MsgBox( _
                 Prompt:="Entered value " & v(k)(i, j) & _
                 " differs from previous value " & .Cells(i, j).Value2
& _
                 " by more than 30%." & vbLf & _
                 "Do you want to make this change?", _
                 Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0),
_
                 Buttons:=vbYesNo _
                ) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

              Else
                .Cells(i, j).Value2 = v(k)(i, j)

              End If

            Else 'no longer numeric

              If MsgBox( _
               Prompt:="Entered value " & v(k)(i, j) & _
               " is nonnumeric but previous value " & .Cells(i,
j).Value2 & _
               " was numeric." & vbLf & "Do you want to make this
change?", _
               Title:="cell " & .Cells(i, j).Address(0,0, xlA1, 0), _
               Buttons:=vbYesNo _
              ) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

            End If

          Else 'wasn't numeric, so any & all changes accepted
            .Cells(i, j).Value2 = v(k)(i, j)

          End If

        Next j
      Next i
    End With
  Next k

CleanUp:
  Application.Calculation = ac
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.EnableCancelKey = xlInterrupt

End Sub

Better still would be intersecting Target with a named range outside
which this check need not be made.
Click to expand...

Thanks for the code! I am getting a syntax error in these 2 areas :

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" differs from previous value " & .Cells(i, j).Value2
& _
" by more than 30%." & vbLf & _
"Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0),
_
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)



If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" is nonnumeric but previous value " & .Cells(i,
j).Value2 & _
" was numeric." & vbLf & "Do you want to make this
change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)


I dont know enough about VB to correct the syntax, can you help me out
real quick?
 
On Sep 17 said:
Thanks for the code!  I am getting a syntax error in these 2 areas :

If MsgBox( _
                 Prompt:="Entered value " & v(k)(i, j) & _
                 " differs from previous value " & .Cells(i, j).Value2
& _
                 " by more than 30%." & vbLf & _
                 "Do you want to make this change?", _
                 Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0),
_
                 Buttons:=vbYesNo _
                ) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)
Click to expand...
....

Probably because the code is line wrapping. Any line of code other
than the initial Sub line and the final End Sub line should be
indented in from the left. If any other lines show nonblank characters
at the beginning of the line, they should be at the end of the
preceding line.
I dont know enough about VB to correct the syntax, can you help me out
real quick?
Click to expand...

Here's the code without any indentation.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, t As Variant, ac As Variant
Dim i As Long, j As Long, k As Long, tac As Long

On Error GoTo CleanUp
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Application.ScreenUpdating = False
ac = Application.Calculation
Application.Calculation = xlCalculationManual

tac = Target.Areas.Count
ReDim v(1 To tac)

For k = 1 To tac
v(k) = Target.Areas(k).Value2

If Not IsArray(v(k)) Then
ReDim t(1 To 1, 1 To 1)
t(1, 1) = v(k)
v(k) = t
Erase t
End If

Next k

Application.Undo

For k = 1 To tac
With Target.Areas(k)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count

If VarType(.Cells(i, j).Value2) = vbDouble Then 'was numeric

If VarType(v(k)(i, j)) = vbDouble Then 'still numeric

If Abs(v(k)(i, j) / .Cells(i, j).Value2 - 1) >= 0.3 Then

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" differs from previous value " & .Cells(i, j).Value2 & _
" by more than 30%." & vbLf & _
"Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

Else
..Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'no longer numeric

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" is nonnumeric but previous value " & .Cells(i, j).Value2 & _
" was numeric." & vbLf & "Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'wasn't numeric, so any & all changes accepted
..Cells(i, j).Value2 = v(k)(i, j)

End If

Next j
Next i
End With
Next k

CleanUp:
Application.Calculation = ac
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.EnableCancelKey = xlInterrupt

End Sub
 
...

Probably because the code is line wrapping. Any line of code other
than the initial Sub line and the final End Sub line should be
indented in from the left. If any other lines show nonblank characters
at the beginning of the line, they should be at the end of the
preceding line.


Here's the code without any indentation.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, t As Variant, ac As Variant
Dim i As Long, j As Long, k As Long, tac As Long

On Error GoTo CleanUp
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Application.ScreenUpdating = False
ac = Application.Calculation
Application.Calculation = xlCalculationManual

tac = Target.Areas.Count
ReDim v(1 To tac)

For k = 1 To tac
v(k) = Target.Areas(k).Value2

If Not IsArray(v(k)) Then
ReDim t(1 To 1, 1 To 1)
t(1, 1) = v(k)
v(k) = t
Erase t
End If

Next k

Application.Undo

For k = 1 To tac
With Target.Areas(k)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count

If VarType(.Cells(i, j).Value2) = vbDouble Then 'was numeric

If VarType(v(k)(i, j)) = vbDouble Then 'still numeric

If Abs(v(k)(i, j) / .Cells(i, j).Value2 - 1) >= 0.3 Then

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" differs from previous value " & .Cells(i, j).Value2 & _
" by more than 30%." & vbLf & _
"Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

Else
.Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'no longer numeric

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" is nonnumeric but previous value " & .Cells(i, j).Value2 & _
" was numeric." & vbLf & "Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'wasn't numeric, so any & all changes accepted
.Cells(i, j).Value2 = v(k)(i, j)

End If

Next j
Next i
End With
Next k

CleanUp:
Application.Calculation = ac
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.EnableCancelKey = xlInterrupt

End Sub
Click to expand...

Thank you sir! You save me a headache.
 
...

Probably because the code is line wrapping. Any line of code other
than the initial Sub line and the final End Sub line should be
indented in from the left. If any other lines show nonblank characters
at the beginning of the line, they should be at the end of the
preceding line.


Here's the code without any indentation.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, t As Variant, ac As Variant
Dim i As Long, j As Long, k As Long, tac As Long

On Error GoTo CleanUp
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Application.ScreenUpdating = False
ac = Application.Calculation
Application.Calculation = xlCalculationManual

tac = Target.Areas.Count
ReDim v(1 To tac)

For k = 1 To tac
v(k) = Target.Areas(k).Value2

If Not IsArray(v(k)) Then
ReDim t(1 To 1, 1 To 1)
t(1, 1) = v(k)
v(k) = t
Erase t
End If

Next k

Application.Undo

For k = 1 To tac
With Target.Areas(k)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count

If VarType(.Cells(i, j).Value2) = vbDouble Then 'was numeric

If VarType(v(k)(i, j)) = vbDouble Then 'still numeric

If Abs(v(k)(i, j) / .Cells(i, j).Value2 - 1) >= 0.3 Then

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" differs from previous value " & .Cells(i, j).Value2 & _
" by more than 30%." & vbLf & _
"Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

Else
.Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'no longer numeric

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" is nonnumeric but previous value " & .Cells(i, j).Value2 & _
" was numeric." & vbLf & "Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'wasn't numeric, so any & all changes accepted
.Cells(i, j).Value2 = v(k)(i, j)

End If

Next j
Next i
End With
Next k

CleanUp:
Application.Calculation = ac
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.EnableCancelKey = xlInterrupt

End Sub
Click to expand...

one quick thing, everything works fine except when the starting value
is 0. If that is the case and a change is made the change
automatically gets reverted back to 0. Is there a way around that?
 
...

Probably because the code is line wrapping. Any line of code other
than the initial Sub line and the final End Sub line should be
indented in from the left. If any other lines show nonblank characters
at the beginning of the line, they should be at the end of the
preceding line.


Here's the code without any indentation.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, t As Variant, ac As Variant
Dim i As Long, j As Long, k As Long, tac As Long

On Error GoTo CleanUp
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Application.ScreenUpdating = False
ac = Application.Calculation
Application.Calculation = xlCalculationManual

tac = Target.Areas.Count
ReDim v(1 To tac)

For k = 1 To tac
v(k) = Target.Areas(k).Value2

If Not IsArray(v(k)) Then
ReDim t(1 To 1, 1 To 1)
t(1, 1) = v(k)
v(k) = t
Erase t
End If

Next k

Application.Undo

For k = 1 To tac
With Target.Areas(k)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count

If VarType(.Cells(i, j).Value2) = vbDouble Then 'was numeric

If VarType(v(k)(i, j)) = vbDouble Then 'still numeric

If Abs(v(k)(i, j) / .Cells(i, j).Value2 - 1) >= 0.3 Then

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" differs from previous value " & .Cells(i, j).Value2 & _
" by more than 30%." & vbLf & _
"Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

Else
.Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'no longer numeric

If MsgBox( _
Prompt:="Entered value " & v(k)(i, j) & _
" is nonnumeric but previous value " & .Cells(i, j).Value2 & _
" was numeric." & vbLf & "Do you want to make this change?", _
Title:="cell " & .Cells(i, j).Address(0, 0, xlA1, 0), _
Buttons:=vbYesNo _
) = vbYes Then .Cells(i, j).Value2 = v(k)(i, j)

End If

Else 'wasn't numeric, so any & all changes accepted
.Cells(i, j).Value2 = v(k)(i, j)

End If

Next j
Next i
End With
Next k

CleanUp:
Application.Calculation = ac
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.EnableCancelKey = xlInterrupt

End Sub
Click to expand...

Ignore that last post :)

I do have one small problem though, I am unable to use the "undo" when
the code is on the sheet. Is there a way I can use the code and still
have the undo function available at the same time?
 
Mangler said:
I do have one small problem though, I am unable to use the "undo" when
the code is on the sheet.  Is there a way I can use the code and still
have the undo function available at the same time?
Click to expand...

Not without storing pre-existing values.
 
...


Not without storing pre-existing values.
Click to expand...

And I assume thats not an quick and easy thing to accomplish?

( Thanks very much for your help on this by the way, I really
appreciate it )
 
Mangler said:
And I assume thats not an quick and easy thing to accomplish?
Click to expand...

The problem is that any time any macro, including event handlers,
changes any cell's contents, Excel purges the ENTIRE undo stack. So if
any macro changes the contents of any cell, you can't undo any changes
you made prior to running the macro. If you want a macro that could
reset cells to their previous contents whenever a user makes a change
that's outside the acceptable percentage change range, then if that
macro does reset a cell's contents, you can't undo any previous
changes.

If all you want is a warning that changes outside the acceptable range
have been made, then you'd need to adapt Bob Umlas's approach.
However, his approach isn't reliable if you or your users make entries
in multiple cell selections. If you're willing to use the
SelectionChange event handler to prevent multiple cell selections,
then you could change his approach to the following.


Option Explicit


Private v As Variant


Private Sub Worksheet_Change(ByVal Target As Range)
Dim aeck As Variant

On Error GoTo CleanUp
aeck = Application.EnableCancelKey
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

If VarType(v) = vbDouble Then
If VarType(Target.Value2) = vbDouble Then
If v = 0 And Target.Value2 <> 0 Then
MsgBox Buttons:=vbOKOnly, _
Prompt:="Cell value was zero but now is nonzero.", _
Title:="cell " & Target.Address(0, 0, xlA1, 0)
ElseIf v <> 0 Then
If Abs(Target.Value2 / v - 1) > 0.3 Then _
MsgBox Buttons:=vbOKOnly, _
Prompt:="New cell value " & Target.Value2 & " has changed "
& _
"by more than 30% from old cell value " & v, _
Title:="cell " & Target.Address(0, 0, xlA1, 0)
End If
Else
MsgBox _
Prompt:="Cell value was numeric but now isn't numeric.", _
Title:="cell " & Target.Address(0, 0, xlA1, 0), _
Buttons:=vbOKOnly
End If
End If

CleanUp:
Application.EnableEvents = True
Application.EnableCancelKey = aeck

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim aeck As Variant
On Error GoTo CleanUp
aeck = Application.EnableCancelKey
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

If Target.Cells.Count > 1 Then ActiveCell.Select
v = ActiveCell.Value2

CleanUp:
Application.EnableEvents = True
Application.EnableCancelKey = aeck

End Sub
 
The problem is that any time any macro, including event handlers,
changes any cell's contents, Excel purges the ENTIRE undo stack. So if
any macro changes the contents of any cell, you can't undo any changes
you made prior to running the macro. If you want a macro that could
reset cells to their previous contents whenever a user makes a change
that's outside the acceptable percentage change range, then if that
macro does reset a cell's contents, you can't undo any previous
changes.

If all you want is a warning that changes outside the acceptable range
have been made, then you'd need to adapt Bob Umlas's approach.
However, his approach isn't reliable if you or your users make entries
in multiple cell selections. If you're willing to use the
SelectionChange event handler to prevent multiple cell selections,
then you could change his approach to the following.

Option Explicit

Private v As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim aeck As Variant

  On Error GoTo CleanUp
  aeck = Application.EnableCancelKey
  Application.EnableCancelKey = xlDisabled
  Application.EnableEvents = False

  If VarType(v) = vbDouble Then
    If VarType(Target.Value2) = vbDouble Then
      If v = 0 And Target.Value2 <> 0 Then
        MsgBox Buttons:=vbOKOnly, _
         Prompt:="Cell value was zero but now is nonzero.", _
         Title:="cell " & Target.Address(0, 0, xlA1, 0)
      ElseIf v <> 0 Then
        If Abs(Target.Value2 / v - 1) > 0.3 Then _
          MsgBox Buttons:=vbOKOnly, _
           Prompt:="New cell value " & Target.Value2 & " has changed "
& _
           "by more than 30% from old cell value " & v, _
           Title:="cell " & Target.Address(0, 0, xlA1, 0)
      End If
    Else
      MsgBox _
       Prompt:="Cell value was numeric but now isn't numeric.",_
       Title:="cell " & Target.Address(0, 0, xlA1, 0), _
       Buttons:=vbOKOnly
    End If
  End If

CleanUp:
  Application.EnableEvents = True
  Application.EnableCancelKey = aeck

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim aeck As Variant
  On Error GoTo CleanUp
  aeck = Application.EnableCancelKey
  Application.EnableCancelKey = xlDisabled
  Application.EnableEvents = False

  If Target.Cells.Count > 1 Then ActiveCell.Select
  v = ActiveCell.Value2

CleanUp:
  Application.EnableEvents = True
  Application.EnableCancelKey = aeck

End Sub
Click to expand...

That is exactly what I needed! Thanks again.
 
The problem is that any time any macro, including event handlers,
changes any cell's contents, Excel purges the ENTIRE undo stack. So if
any macro changes the contents of any cell, you can't undo any changes
you made prior to running the macro. If you want a macro that could
reset cells to their previous contents whenever a user makes a change
that's outside the acceptable percentage change range, then if that
macro does reset a cell's contents, you can't undo any previous
changes.

If all you want is a warning that changes outside the acceptable range
have been made, then you'd need to adapt Bob Umlas's approach.
However, his approach isn't reliable if you or your users make entries
in multiple cell selections. If you're willing to use the
SelectionChange event handler to prevent multiple cell selections,
then you could change his approach to the following.

Option Explicit

Private v As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim aeck As Variant

  On Error GoTo CleanUp
  aeck = Application.EnableCancelKey
  Application.EnableCancelKey = xlDisabled
  Application.EnableEvents = False

  If VarType(v) = vbDouble Then
    If VarType(Target.Value2) = vbDouble Then
      If v = 0 And Target.Value2 <> 0 Then
        MsgBox Buttons:=vbOKOnly, _
         Prompt:="Cell value was zero but now is nonzero.", _
         Title:="cell " & Target.Address(0, 0, xlA1, 0)
      ElseIf v <> 0 Then
        If Abs(Target.Value2 / v - 1) > 0.3 Then _
          MsgBox Buttons:=vbOKOnly, _
           Prompt:="New cell value " & Target.Value2 & " has changed "
& _
           "by more than 30% from old cell value " & v, _
           Title:="cell " & Target.Address(0, 0, xlA1, 0)
      End If
    Else
      MsgBox _
       Prompt:="Cell value was numeric but now isn't numeric.",_
       Title:="cell " & Target.Address(0, 0, xlA1, 0), _
       Buttons:=vbOKOnly
    End If
  End If

CleanUp:
  Application.EnableEvents = True
  Application.EnableCancelKey = aeck

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim aeck As Variant
  On Error GoTo CleanUp
  aeck = Application.EnableCancelKey
  Application.EnableCancelKey = xlDisabled
  Application.EnableEvents = False

  If Target.Cells.Count > 1 Then ActiveCell.Select
  v = ActiveCell.Value2

CleanUp:
  Application.EnableEvents = True
  Application.EnableCancelKey = aeck

End Sub
Click to expand...

Actually if your still out there I have one more question. Seeing
that it obviously looks like your a pro with vb maybe you could refer
me to a good trusted source to learn a few things?
 
Mangler said:
. . . maybe you could refer me to a good trusted source to learn a few things?
Click to expand...

Not me. I'm self-taught in VBA. I learned programming a long time ago
using other languages. I'm not familiar with what's available in
introductory VBA books.

You could try a Google Groups search in the Excel newsgroups for VBA
books and other learning resources. That's been asked and answered
many times.
 
Back
Top