Data Validation and VBA

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.

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.

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