Case validation of fields is looping. Why?

[cherosoullis]

I have this code below but there is an error on it.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 7 And Target.Column = 3 Then
Select Case Cells(5, 3).Value
Case "A:0-1650cc"
If Target.Value >= 0 And Target.Value <= 1650 Then
Exit Sub
Else
MsgBox ("Please, insert value from 0 to 1650")
Target.Select
Target.ClearContents
End If

Case "A:1651cc - 2250cc"
If Target.Value > 1650 And Target.Value <= 2025 Then
Exit Sub
Else
MsgBox ("Please, insert value from 1651 to 2025")
Target.Select
Target.ClearContents
End If

Case "A:2251cc - 3000cc"
If Target.Value > 2251 And Target.Value <= 3000 Then
Exit Sub
Else
MsgBox ("Please, insert value from 2251 to 3000")
Target.Select
Target.ClearContents
End If

End Select
End If
End Sub

The second and the thirth popup message is looping and is not stopping in order to enter another value in it. Why is that?

[johnske]

This is event code and you need to disable events to stop looping, try...
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 7 And Target.Column = 3 Then
Application.EnableEvents = False
Select Case Cells(5, 3).Value
Case "A:0-1650cc"
If Target.Value >= 0 And Target.Value <= 1650 Then
Exit Sub
Else
MsgBox ("Please, insert value from 0 to 1650")
Target.Select
Target.ClearContents
End If
Case "A:1651cc - 2250cc"
If Target.Value > 1650 And Target.Value <= 2025 Then
Exit Sub
Else
MsgBox ("Please, insert value from 1651 to 2025")
Target.Select
Target.ClearContents
End If
Case "A:2251cc - 3000cc"
If Target.Value > 2251 And Target.Value <= 3000 Then
Exit Sub
Else
MsgBox ("Please, insert value from 2251 to 3000")
Target.Select
Target.ClearContents
End If
End Select
Application.EnableEvents = True
End If
End Sub

[Bob Phillips]

When turning events off best to trap errors, and best to set it back to true



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit
Application.EnableEvents = False

With Target
If .Row = 7 And .Column = 3 Then
Select Case Cells(5, 3).Value
Case "A:0-1650cc"
If .Value >= 0 And .Value <= 1650 Then
Exit Sub
Else
MsgBox ("Please, insert value from 0 to 1650")
.ClearContents
End If
Case "A:1651cc - 2250cc"
If .Value > 1650 And .Value <= 2025 Then
Exit Sub
Else
MsgBox ("Please, insert value from 1651 to 2025")
.ClearContents
End If
Case "A:2251cc - 3000cc"
If .Value > 2251 And .Value <= 3000 Then
Exit Sub
Else
MsgBox ("Please, insert value from 2251 to 3000")
.ClearContents
End If
End Select
End If
End With

ws_exit:
Application.EnableEvents = True
End Sub

[Charlize]

Try this.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 7 And Target.Column = 3 Then
Select Case Cells(5, 3).Value
Case "A:0-1650cc"
If Target.Value >= 0 And Target.Value <= 1650 Then
Exit Sub
Else
MsgBox ("Please, insert value from 0 to 1650")
Application.EnableEvents = False
Target.Select
Target.ClearContents
GoTo wsexit
End If
Case "A:1651cc-2250cc"
If Target.Value > 1650 And Target.Value <= 2250 Then
Exit Sub
Else
MsgBox ("Please, insert value from 1651 to 2250")
Application.EnableEvents = False
Target.Select
Target.ClearContents
GoTo wsexit
End If
Case "A:2251cc-3000cc"
If Target.Value > 2250 And Target.Value <= 3000 Then
Exit Sub
Else
MsgBox ("Please, insert value from 2251 to 3000")
Application.EnableEvents = False
Target.Select
Target.ClearContents
GoTo wsexit
End If
End Select
End If
wsexit:
Application.EnableEvents = True
End Sub

[johnske]

I just tested this, your Exit Sub was bypassing the Application.EnableEvents = True statement and leaving events disabled, try this instead...
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address(0, 0) = "C7" Then
Application.EnableEvents = False
On Error GoTo Finish
Select Case Range("C5").Value
Case "A:0-1650cc"
If Not (.Value >= 0 And .Value <= 1650) Then
MsgBox ("Please, insert value from 0 to 1650")
.Select
.ClearContents
End If
Case "A:1651cc - 2250cc"
If Not (.Value > 1650 And .Value <= 2025) Then
MsgBox ("Please, insert value from 1651 to 2025")
.Select
.ClearContents
End If
Case "A:2251cc - 3000cc"
If Not (.Value > 2251 And .Value <= 3000) Then
MsgBox ("Please, insert value from 2251 to 3000")
.Select
.ClearContents
End If
End Select
End If
End With
Finish:
Application.EnableEvents = True
End Sub

[Charlize]

My version worked for me ? At least I thought it did but I could be wrong.

Charlize

[cherosoullis]

It work