PDA

View Full Version : Need help with a multiple if statement on a change event procedure



bananatang
08-30-2009, 07:51 PM
Hi,

i need some help once again to get this code working properly. I have tried for hours and getting fed up now.

I previously got help from user GTO with this code, however i had to add a couple of more if statements and i cannot get the code to give the results i want.

Summary.
1st condition

I have a cell E13 which has a default text "Insert Date" in it.

The conditions i wish to apply to this cell is

If the user deletes the text and leaves the cell blank or inserts some other text. I want a msgbox to notify the user that this cell cannot be left blank etc, and as a result will return the text "Insert Date" back into the cell.

If the user inserts a date value to notify user via msgbox.

2nd condition

I have a cell U13 which has a default text "Insert Date" in it.
If the user deletes the text and leaves the cell blank or inserts some other text. I want a msgbox to notify the user that this cell cannot be left blank etc, and as a result will return the text "Insert Date" back into the cell.

if the user inserts a date value to cell (U13) to check if cell (BX13) value matches cell BM39 value, if so notify user via msgbox that the data matches.

OR

if the user inserts a date value to the cell (U13) to check if cell (BX13) value does not match cell BM39 value, if so notify user via msgbox that the data does not match.

AND

IF a date value is removed from U13, to notify user of this and to reinsert the default text "Insert Date"

The code i have is as follows

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo error1:

If Not Application.Intersect(Target, Range("U13")) Is Nothing _
And Not Target.Count > 1 Then

If Not IsDate(Cells(13, 21).Value) Then
MsgBox "This cell cannot be left blank" & vbCrLf & _
"This Cell will return to its original value", _
vbCritical, "Blank Cell is not permitted"

'// Kill App events for a moment, or it will recurse//
Application.EnableEvents = False
Range("U13").Value = "Insert Date"
Application.EnableEvents = True
Range("U13").Select

ElseIf Range("BX13").Value = Range("BM39").Value Then
MsgBox " The Pupil will be recorded as now being ""OFF ROLL""" & Chr(13) _
& Chr(13) _
& "The attendances codes logged for this student matches the duration" & Chr(13) _
& "the pupil has been at the IEC" & Chr(13) _
& Chr(13) _
& "Well Done !!!!!!", vbInformation, "Pupil now designated as being Off Roll"
Else
MsgBox "STOP !!! STOP !!!! STOP !!!!!" & Chr(13) _
& Chr(13) _
& " You have not recorded all Attendance Sessions for the period" & Chr(13) _
& " the pupil has been on roll....." & Chr(13) _
& Chr(13) _
& "Please ensure an Attendance Code is logged for each day the pupil" & Chr(13) _
& "has been On Roll" & Chr(13) _
& Chr(13) _
& "Thank You !!!!!", vbCritical, "Attendance Sessions Conflict"

Application.EnableEvents = False
'Range("U13").Value = "Insert Date"
Application.EnableEvents = True
Range("U13").Select


If Not Application.Intersect(Target, Range("E13")) Is Nothing _
And Not Target.Count > 1 Then

If Not IsDate(Cells(13, 5).Value) Then
MsgBox "This cell cannot be left blank" & vbCrLf & _
"This Cell will return to its original value", _
vbCritical, "Blank Cell is not permitted"

'// Kill App events for a moment, or we will recurse//
Application.EnableEvents = False
Range("E13").Value = "Insert Date"
Application.EnableEvents = True
Range("E13").Select
End If
End If
End If
End If


Exit Sub
error1:
MsgBox "Please Add an ON ROLL Date, as it is currently missing"
Application.EnableEvents = False
Range("E13").Value = "Insert Date"
'Range("U13").Value = "Insert Date"
Application.EnableEvents = True
'Resume Next

End Sub

What i am trying to ensure is that cells E13 and U13 are never blank. They should either have the text "Insert date" or a date value in them.

I have attached a copy of the worksheet which may help.

Thnks

BT

p45cal
08-31-2009, 12:22 AM
this should start you on a solution:Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo error1:

If Not Application.Intersect(Target, Union(Range("U13"), Range("E13"))) Is Nothing _
And Not Target.Count > 1 Then
If Not IsDate(Target.Value) Then
MsgBox "This cell cannot be left blank" & vbCrLf & _
"This Cell will return to its original value", _
vbCritical, "Blank Cell is not permitted"
'// Kill App events for a moment, or it will recurse//
Application.EnableEvents = False
Target.Value = "Insert Date"
Application.EnableEvents = True
Target.Select
Else
If Target.Address = Range("U13").Address Then
If Range("BX13").Value = Range("BM39").Value Then
MsgBox " The Pupil will be recorded as now being ""OFF ROLL""" & Chr(13) _
& Chr(13) _
& "The attendances codes logged for this student matches the duration" & Chr(13) _
& "the pupil has been at the IEC" & Chr(13) _
& Chr(13) _
& "Well Done !!!!!!", vbInformation, "Pupil now designated as being Off Roll"
Else
MsgBox "STOP !!! STOP !!!! STOP !!!!!" & Chr(13) _
& Chr(13) _
& " You have not recorded all Attendance Sessions for the period" & Chr(13) _
& " the pupil has been on roll....." & Chr(13) _
& Chr(13) _
& "Please ensure an Attendance Code is logged for each day the pupil" & Chr(13) _
& "has been On Roll" & Chr(13) _
& Chr(13) _
& "Thank You !!!!!", vbCritical, "Attendance Sessions Conflict"

Application.EnableEvents = False
'Range("U13").Value = "Insert Date"
Application.EnableEvents = True
Range("U13").Select
End If
End If
End If
End If

Exit Sub
error1:
MsgBox "Please Add an ON ROLL Date, as it is currently missing"
Application.EnableEvents = False
Range("E13").Value = "Insert Date"
'Range("U13").Value = "Insert Date"
Application.EnableEvents = True
'Resume Next

End Sub
(I've tried to remember the changes I made and highlighted then in red, memory and thecodenet VBA tags permitting!)

bananatang
08-31-2009, 03:00 AM
Hi P45cal

Thank you for your help and providing me with an amended code.

The code supplied does work well, however it is possible to add code to ensure that if a user enters a date and then deletes the date and the cell remains blank to have a msgbox inform user and for the cell to return back to the default text of "Insert date"

I would need this apply to both cells i.e. E13 nd U13

Thanks in advance

BT