Data Validation and VBA

If I enter 35 data validation isn't triggered and the VBA "logic" doesn't loop (at any time)

If I enter 950 data validation (in Excel not VBA) is triggered and retry is selected - enter 35 and the VBA "logic" loops twice

 

I'm using Worksheet_Change(ByVal Target As Range)

I'm using Application.EnableEvents = False

 

with calling of several sub-routines.

 

I reset the Application.EnableEvents to True only once at the end of the Worksheet_Change sub()

 

Is there another "setting" that needs to be controlled - in addition to EnableEvent?

 

PS - I'm also controlling ScreenUpdating.


 

 

 

Please post all of the code in the change event so we can see what it is doing and tell us exactly how you have set the data validation including the range and formula etc so we can see what that is doing also.
Regards,

OssieMac

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

Attached is the "reduced" code (the problem still exists)

 

Sub Worksheet_Change(ByVal Target As Range)

Dim ProdCode As String
Dim PremLmt As Double

ProdCode = Replace(Range("product").Value, " ", "")
PremLmt = 1000000

'Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
       
'    If Range("pSPnum") > 0 Then
        shtInput.Range("pSP1a").Validation.ErrorMessage = "Total Premium contributions are limited to " & _
            Format(PremLmt - (shtInput.Range("pSP2a") + shtInput.Range("pSP3a") + shtInput.Range("pSP4a") + shtInput.Range("pSP5a")), "$#,###,##0")
        shtInput.Range("pSP2a").Validation.ErrorMessage = "Total Premium contributions are limited to " & _
            Format(PremLmt - (shtInput.Range("pSP1a") + shtInput.Range("pSP3a") + shtInput.Range("pSP4a") + shtInput.Range("pSP5a")), "$#,###,##0")
        shtInput.Range("pSP3a").Validation.ErrorMessage = "Total Premium contributions are limited to " & _
            Format(PremLmt - (shtInput.Range("pSP1a") + shtInput.Range("pSP2a") + shtInput.Range("pSP4a") + shtInput.Range("pSP5a")), "$#,###,##0")
        shtInput.Range("pSP4a").Validation.ErrorMessage = "Total Premium contributions are limited to " & _
            Format(PremLmt - (shtInput.Range("pSP1a") + shtInput.Range("pSP2a") + shtInput.Range("pSP3a") + shtInput.Range("pSP5a")), "$#,###,##0")
        shtInput.Range("pSP5a").Validation.ErrorMessage = "Total Premium contributions are limited to " & _
            Format(PremLmt - (shtInput.Range("pSP1a") + shtInput.Range("pSP2a") + shtInput.Range("pSP3a") + shtInput.Range("pSP5a")), "$#,###,##0")
'    End If
   
    If Target.Address = Range("pSPnum").Address And Range("pSPnum") = 0 Then Range("pSPnum").Select
       
InputCheck.check_error

shtInput.Protect "Canada"

Application.EnableEvents = True
Application.ScreenUpdating = True
   

Sub check_error()

    If shtAccEng.Range("MaxContribution") > 1000000 Then
        MsgBox ("Flexible premium changed to keep contribution under $1,000,000")
        shtInput.Range("pMPrem") = Application.RoundDown((1000000 - shtInput.Range("pSP1a") - shtInput.Range("pSP2a") - shtInput.Range("pSP3a") - shtInput.Range("pSP4a") - shtInput.Range("pSP5a")) / shtInput.Range("pMode"), 2)
    End If
       
    If shtAccEng.Range("MaxContribution") = 1000000 Then
       MsgBox ("Contribution limit of one million met or exceeded - contribution stopped")
    End If
  
   
End Sub

 

For date validation

only whole numbers are to be accepted

data between 0,=pLimit-C20-C24-C26-C28

 

pLimit = 1,000,000

Cell C20 = 100,000

I put in 950,000 - get the error message and rekey in 35,000 (I know that I originally used 950 and 35 - trying to keep things simple)

 

Nothing with input message

Error alert style - stop

Error alert title - Total premium contribution are limited to $900,000 (this is change by code above)

 

I believe that triggering the data validation (by exceeding the max) is causing two events to occur that I wasn't expecting - and therefore causing the looping.

 

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

It is nearly 7am in  my part of the world and unfortunately I will not be available for the next 7-8 hours and have not got time to go into this in depth at the moment.

However, I have had a quick look and I cannot see where you restrict the change event to a specific cell or a specific range and therefore the change event may be getting called if the code changes any other cells on the worksheet.

Change event code should take the format below and identify the cell/range for which the code should be processed.

If disabling events then it needs to handle code errors and turn events back on because once turned off, they stay off until turned back on. (Disabling the On Error during testing is OK to isolate a code error but don't forget to turn it back on. Can be turned on with another sub or in the immediate window.)

 

Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ReEnableEvents
    Application.EnableEvents = False
   
    If Target.Address = "$A$2" Then
    'Alternatively to allow processing if the change can be within a range
    'If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
   
        'Processing code here
    End If
   
    'Following after End If
ReEnableEvents:
    Application.EnableEvents = True
    If Err.Number > 0 Then
        MsgBox "Error occurred in Sub Worksheet_Change. Error number: " & Err.Number
    End If
End Sub

 

Should also handle re-enable events in any subs called from the event in case there is an error in the called sub.

Sub check_error()
    On Error GoTo ReEnableEvents

    'Processing code in here
   
   
'After all other code
ReEnableEvents:
    If Err.Number > 0 Then
        MsgBox "Error occurred in Sub check_error. Error number: " & Err.Number
    End If
    Application.EnableEvents = True
End Sub

 

I suspect that the data validation is interfering because you get a change when the first value is entered and again when corrected etc. Therefore I would include the data validation in the Change event and leave out the data validation. You can even code it to remove any decimal places automatically with the following code. Note the comment.

Target.Value = CLng(Target.Value)   'Removes decimals an rounds to nearest whole number.


 

 

 

 

Regards,

OssieMac

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

I suspect that the original post is a variation on the situation described by the commentary in the following workaround for that problem:

Private LastChngAdr As String
Private LastChngVal As String

Private Sub Worksheet_Change(ByVal Target As Range)

    'Excel (2003) has a design flaw in which worksheet-change events are
    'not disabled by Excel's data validation when it restores a cell's
    'previous value after a validation error.  Consequently, when the user
    'changes the cell's value again (or accepts the restored value, by
    'selecting a different cell) the Worksheet_Change event gets called
    'three times: once for the user's first, invalid entry; once for data-
    'validation's restoration of the previous value; and once for the
    'user's updated entry (or acceptance of the restored value, by
    'selecting a different cell).  The following workaround, in combin-
    'ation with the Worksheet_SelectionChange event handler's reset-code,
    'suppresses the extra Worksheet_Change events.

    If Target(1).Address = LastChngAdr And Target.Value = LastChngVal _
        Then Exit Sub
       
    LastChngAdr = Target(1).Address '"Target(1)" in case of merged cells.
    LastChngVal = Target.Value
    
    'Continue with whatever change-event processing...
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'See the note about the Excel (2003) design flaw in the Worksheet_
    'Change event handler, regarding data validation and worksheet-change
    'events.
    
    If Target(1).Address <> LastChngAdr Then '"Target(1)" in case of merged cells.
        'Is the selection of the new cell (not the data-validation's re-
        'selection of the validated cell), so reset the Worksheet_Change
        'event suppression.
        
        LastChngAdr = vbNullString
        LastChngVal = vbNullString
    End If
End Sub

3 people found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated December 14, 2020 Views 2,448 Applies to: