Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,564
- Office Version
- 365
- 2016
- Platform
- Windows
I have this code:
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]
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]