Worksheet Change Event Using Target Intersect Triggers Unrelated Worksheet Validation Error

[Ark68]

I have this code:

'START TEMP CHANGE
    If Not Intersect(Target, Range("$F$7")) Is Nothing Then
        mbevents = False
        Unprotect
        
        vsttemp = Target.Value
        If Application.WorksheetFunction.IsNumber(vsttemp) = False Then
            MsgBox "Enter a number only.", vbExclamation, "Invalid Temperature"
            Range("F7") = ""
            Range("F7").Select
        ElseIf vsttemp < -40 Or vsttemp > 40 Then
            MsgBox "Seems unlikely.", vbExclamation, "Invalid Temperature"
            Range("F7") = ""
            Range("F7").Select
        End If
        
        Range("I7:J7").Locked = False
        With ws_gui
            .Shapes("btn_grp_1").OnAction = "'" & ActiveWorkbook.Name & "'!btn_mclr"
            .Shapes("btn_grp_2").OnAction = "'" & ActiveWorkbook.Name & "'!btn_ovc"
            .Shapes("btn_grp_3").OnAction = "'" & ActiveWorkbook.Name & "'!btn_mcl"
            .Shapes("btn_grp_4").OnAction = "'" & ActiveWorkbook.Name & "'!btn_flr"
            .Shapes("btn_grp_5").OnAction = "'" & ActiveWorkbook.Name & "'!btn_sql"
            .Shapes("btn_grp_6").OnAction = "'" & ActiveWorkbook.Name & "'!btn_snw"
            .Shapes("btn_grp_7").OnAction = "'" & ActiveWorkbook.Name & "'!btn_mxd"
            .Shapes("btn_grp_8").OnAction = "'" & ActiveWorkbook.Name & "'!btn_rain"
            .Shapes("btn_grp_9").OnAction = "'" & ActiveWorkbook.Name & "'!btn_fzr"
            .Shapes("btn_grp_10").OnAction = "'" & ActiveWorkbook.Name & "'!btn_wnd"
            .Shapes("btn_grp_11").OnAction = "'" & ActiveWorkbook.Name & "'!btn_clr"
        End With
        Range("I7").Select
        Protect
        mbevents = True
    End If

If is part of a worksheet change event.

If the user enters a number, say 100, in F7 - a number which should trigger the invalid value message box, it first displays the cell validation message for an invalid list selection from cell E3, followed then by two cell validation messages from two other cells. I hope I explained myself OK. What could I be doing wrong?

Here is my full worksheet change code.
Private Sub Worksheet_change(ByVal Target As Range)
Dim sName As String
Dim leNum As Long
Dim lshift As Long
Dim sShift As String
Dim dShifts As Double
Dim dShifte As Double

If Not mbevents Then Exit Sub
'YEAR CHANGE
'Stop
If Not mbevents Then Exit Sub
If Not Intersect(Target, Range("$C$3")) Is Nothing Then
dSYear = Target.Value
dCYear = Year(Now)
If dSYear > dCYear Then
MsgBox "Unable to track events into the future.", vbExclamation, "INVALID ENTRY"
mbevents = False
Target.Value = dCYear
mbevents = True
Exit Sub
End If
Range("G3").Validation.Delete
tleap = Application.WorksheetFunction.VLookup(dSYear, ws_lists.Range("AG2:AH9"), 2, False)
tmonth = Format(Month(DateValue("1 " & Range("E3") & " 2020")), "00")
Unprotect
If tmonth = 2 Then
If tleap = True Then
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_leap"
If ws_gui.Range("G3") > 29 Then
Range("G3") = ""
Range("C4") = ""
Range("G3").Select
mbevents = True
Protect
Exit Sub
End If
Else
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_feb"
If ws_gui.Range("G3") > 28 Then
Range("G3") = ""
Range("C4") = ""
Range("G3").Select
mbevents = True
Protect
Exit Sub
End If
End If
ElseIf tmonth = 1 Or tmonth = 3 Or tmonth = 5 Or tmonth = 7 Or tmonth = 8 Or tmonth = 10 Or tmonth = 12 Then
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_31"
Else
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_30"
If ws_gui.Range("G3") > 30 Then
Range("G3") = ""
Range("C4") = ""
Range("G3").Select
mbevents = True
Exit Sub
Protect
End If
End If
dNDate = DateSerial(dSYear, tmonth, Range("G3"))
mbevents = False
Range("C4") = UCase(Format(dNDate, "DDDD"))
Range("B24") = Format(dNDate, "dd-mmm-yy")
mbevents = True
Protect
End If

'MONTH CHANGE
'Stop
If Not mbevents Then Exit Sub
'If Target.Address = "$E$3" Then
If Not Intersect(Target, Range("$E$3")) Is Nothing Then
dSMonth = Target.Value
dSYear = Range("C3")
Range("G3").Validation.Delete
tleap = Application.WorksheetFunction.VLookup(dSYear, ws_lists.Range("AG2:AH9"), 2, False)
tmonth = Format(Month(DateValue("1 " & dSMonth & " 2020")), "00")
Unprotect
mbevents = False
If tmonth = 2 Then
If tleap = True Then 'LEAP YEAR - 29 days max
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_leap"
If ws_gui.Range("G3") > 29 Then
Range("G3") = ""
Range("C4") = ""
Range("G3").Select
mbevents = True
Protect
Exit Sub
End If
Else 'NON-LEAP YEAR - 28 days max
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_feb"
If ws_gui.Range("G3") > 28 Then
Range("G3") = ""
Range("C4") = ""
Range("G3").Select
mbevents = True
Protect
Exit Sub
End If
End If
ElseIf tmonth = 1 Or tmonth = 3 Or tmonth = 5 Or tmonth = 7 Or tmonth = 8 Or tmonth = 10 Or tmonth = 12 Then
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_31"
Else
ws_gui.Range("G3").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=tday_30"
If ws_gui.Range("G3") > 30 Then
Range("G3") = ""
Range("C4") = ""
Range("G3").Select
mbevents = True
Protect
Exit Sub
End If
End If
dNDate = DateSerial(dSYear, tmonth, Range("G3"))
mbevents = False
Range("C4") = UCase(Format(dNDate, "DDDD"))
Range("B24") = Format(dNDate, "dd-mmm-yy")
mbevents = True
Protect
End If

'DAY CHANGE
'Stop
If Not mbevents Then Exit Sub
'If not Target.Address = "$G$3" as nothing Then
If Not Intersect(Target, Range("$G$3")) Is Nothing Then
dSDay = Target.Value
dSMonth = Format(Month(DateValue("1 " & Range("E3") & " 2020")), "00")
dSYear = Range("C3").Value
dNDate = DateSerial(dSYear, dSMonth, dSDay)
mbevents = False
Unprotect
Range("C4") = UCase(Format(dNDate, "DDDD"))
Range("B24") = Format(dNDate, "dd-mmm-yy")
mbevents = True
Protect
End If

'NAME CHANGE
'If Target.Address = "$M$2" Then
'Stop
If Not Intersect(Target, Range("$M$2")) Is Nothing Then
Unprotect
mbevents = False
sName = Target.Value
With Range("M2").Font
.Color = RGB(19, 65, 98)
.Italic = False
End With
'MsgBox sName, , "NAME CHANGE"
If sName = "- - - - - - - - - - - - - -" Then
Range("M2") = " - Select operator -"
With Range("M2").Font
.Color = RGB(192, 0, 0)
.Italic = True
End With
mbevents = True
Protect
Exit Sub
End If

leNum = Application.WorksheetFunction.VLookup(sName, ws_lists.Range("A2:B50"), 2, False) 'employee number
lshift = Application.WorksheetFunction.VLookup(sName, ws_lists.Range("A2:C50"), 3, False) 'employee's base shift
sShift = Application.WorksheetFunction.VLookup(lshift, ws_lists.Range("AK2:AN5"), 2, False) 'shift name
dShifts = Application.WorksheetFunction.VLookup(lshift, ws_lists.Range("AK2:AN5"), 3, False)
dShifte = Application.WorksheetFunction.VLookup(lshift, ws_lists.Range("AK2:AN5"), 4, False)
Range("T2") = leNum
With Range("M3").Font
.Color = RGB(19, 65, 98)
.Italic = False
End With
Range("M3") = sShift
Range("M3:S3").Locked = False
Range("R3") = dShifts
Range("T3") = dShifte
Range("M4:N4").Locked = False

Range("E24").Value = sName
Range("K24") = leNum
Range("M24") = Format(Range("R3"), "h:mm AM/PM")
Range("O24") = Format(Range("T3"), "h:mm AM/PM")

mbevents = True
Protect
End If

'SHIFT CHANGE
'If Target.Address = "$M$3" Then
If Not Intersect(Target, Range("$M$3")) Is Nothing Then
mbevents = False
Unprotect
sShift = Target.Value 'shift name
'Stop
With Range("M3").Font
.Color = RGB(19, 65, 98)
.Italic = False
End With
If sShift = "[4] Other" Then
Range("R3").Value = ""
Range("T3").Value = ""
Range("R3:S3").Interior.Color = RGB(216, 241, 234)
Range("R3:S3").Locked = False
Range("R3").Select
mbevents = True
Protect
Exit Sub
Else
dShifts = Application.WorksheetFunction.VLookup(sShift, ws_lists.Range("AL2:AN5"), 2, False)
dShifte = Application.WorksheetFunction.VLookup(sShift, ws_lists.Range("AL2:AN5"), 3, False)
Range("R3") = dShifts
Range("T3") = dShifte
End If
MsgBox sShift, , "SHIFT CHANGE"
Range("M4:N4").Locked = False
Range("M4").Select
mbevents = True
Protect
End If

'EQT CHANGE
'If Target.Address = "$M$3" Then
If Not Intersect(Target, Range("$M$4")) Is Nothing Then
mbevents = False
Unprotect
vEqt = Target.Value
If vEqt = "- - -" Then
With Range("M4")
.Value = ""
.Color = RGB(19, 65, 98)
.Italic = False
End With
mbevents = True
Protect
Exit Sub
End If
seqt = Application.WorksheetFunction.VLookup(vEqt, ws_lists.Range("E2:G36"), 2, False)
Range("O4") = seqt
Range("W3:X4").Locked = False
'Range("W3").Select
Range("F7:G7").Locked = False
'Range("I7:J7").Locked = False
'Range("C9:D19").Locked = False
Range("Q24") = Range("M4")
Range("F7").Select
Protect
mbevents = True
End If

'ZONE CHANGE
If Not Intersect(Target, Range("$M$9")) Is Nothing Then
mbevents = False
Unprotect
vZone = Target.Value
sZone = Application.WorksheetFunction.VLookup(vZone, ws_lists.Range("N2:O32"), 2, False)
'Range("Y4") = sZone
Range("F7:G7").Locked = False
Range("C9:D19").Locked = False
Range("F7").Select
Protect
mbevents = True
End If

'START TEMP CHANGE
If Not Intersect(Target, Range("$F$7")) Is Nothing Then
mbevents = False
Unprotect

vsttemp = Target.Value
If Application.WorksheetFunction.IsNumber(vsttemp) = False Then
MsgBox "Enter a number only.", vbExclamation, "Invalid Temperature"
Range("F7") = ""
Range("F7").Select
ElseIf vsttemp < -40 Or vsttemp > 40 Then
MsgBox "Seems unlikely.", vbExclamation, "Invalid Temperature"
Range("F7") = ""
Range("F7").Select
End If

Range("I7:J7").Locked = False
With ws_gui
.Shapes("btn_grp_1").OnAction = "'" & ActiveWorkbook.Name & "'!btn_mclr"
.Shapes("btn_grp_2").OnAction = "'" & ActiveWorkbook.Name & "'!btn_ovc"
.Shapes("btn_grp_3").OnAction = "'" & ActiveWorkbook.Name & "'!btn_mcl"
.Shapes("btn_grp_4").OnAction = "'" & ActiveWorkbook.Name & "'!btn_flr"
.Shapes("btn_grp_5").OnAction = "'" & ActiveWorkbook.Name & "'!btn_sql"
.Shapes("btn_grp_6").OnAction = "'" & ActiveWorkbook.Name & "'!btn_snw"
.Shapes("btn_grp_7").OnAction = "'" & ActiveWorkbook.Name & "'!btn_mxd"
.Shapes("btn_grp_8").OnAction = "'" & ActiveWorkbook.Name & "'!btn_rain"
.Shapes("btn_grp_9").OnAction = "'" & ActiveWorkbook.Name & "'!btn_fzr"
.Shapes("btn_grp_10").OnAction = "'" & ActiveWorkbook.Name & "'!btn_wnd"
.Shapes("btn_grp_11").OnAction = "'" & ActiveWorkbook.Name & "'!btn_clr"
End With
Range("I7").Select
Protect
mbevents = True
End If

'TEMP END CHANGE
'If Target.Address = "$M$3" Then
If Not Intersect(Target, Range("$I$7")) Is Nothing Then
mbevents = False
Unprotect
vsttemp = Target.Value
If Application.WorksheetFunction.IsNumber(vsttemp) = False Then
MsgBox "Enter a number only.", vbExclamation, "Invalid Temperature"
Range("I7") = ""
Range("I7").Select
ElseIf vsttemp < -40 Or vsttemp > 40 Then
MsgBox "Seems unlikely.", vbExclamation, "Invalid Temperature"
Range("I7") = ""
Range("I7").Select
End If
Protect
mbevents = True
End If

End Sub
[/code]

 

[Alex Blakenburg]

It might be worth trying turning enable events off and on as a starting point.

Application.EnableEvents = False
'... the rest of the code
Application.EnableEvents = True

 

[Ark68]

Hi Alex,
Thank you for your suggestion. I added this code to to the worksheet change event relevant to the change of cell F7 , and to the whole worksheet change procedure, but it still resulted in the same error.

I did find my error though. It appears as though I had started to implement data validation of cell F2 and my error message was copied from another cell and irrelevant to F7. That threw me off as to what had been being triggered. So, with data validation removed, my code worked.

I would much rather use data validation though, so going to remove this error checking code.

 

[Alex Blakenburg]

Thanks for letting me know. Glad you found a way forward.