A msg box only sometimes alerts on earlier date entered

[dpaton05]

I have a table and the first column for a row is the date. If a date is entered that is earlier then today's date, a message box should appear and ask you if that is what you want. It is just to add an extra layer of protection against typos. If a new row is added then a date entered that is earlier than today, the message box will appear but if you open the worksheet and straight away enter a date without adding any new rows, the message box will not appear. What do I need to change so that the message box will appear regardless?

Thanks,
Dave


I think this is the part that needs to be changed:

Private Sub Worksheet_Change(ByVal Target As Range)
'Worksheets("Costing_tool").Unprotect
Dim ans As String
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
        If Target.Value < Date Then
            ans = MsgBox("This input is older than today !....Are you sure that is what you want ???", vbYesNo)
        If ans = vbNo Then Target.Value = ""
        End If
    End If


    Application.EnableEvents = True
'Worksheets("Costing_tool").Protect
End Sub

 

[dpaton05]

That may be because this code has no bearing on the "costingTool" sheet.....which the worksheet event code applies to !
You may need to put the event code in quote sheet as well !

Even though I have code to unprotect the costing_tool sheet at the start of the other code, the code does not apply to the costing_tool sheet. It is stored in the quote sheet.

 

[Michael M]

Change this code

If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub

TO

If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then 
Application.EnableEvents = true
Exit Sub
end if

 

[dpaton05]

Do I need to change in the worksheet change event for the quote sheet, costing tool or both?

 

[dpaton05]

I changed it in the quote sheet worksheet change event, then tried to enter a date in the quote sheet before the current date and nothing happened.

 

[Peter_SSs]

Thanks for the reply Peter. Sorry, I didn't really follow with what I need to do to get it working. Could you let me know please?

I am not going to try to tell you exactly as you have quite a complicated sheet with lots of code that would take me too long to work through with every combination of uses of those codes.

What you do need to do is very carefully check that every time you set EnableEvents to False, EnableEvents get sets back to True before the code finishes.

I changed it in the quote sheet worksheet change event, then tried to enter a date in the quote sheet before the current date and nothing happened.

Most likely because your Events are disabled as described previously. Try saving, closing right out of Excel and then restarting Excel and opening your workbook.

 

[dpaton05]

So if enabling events is set to false, the alert will not be fired off?

 

[dpaton05]

What you do need to do is very carefully check that every time you set EnableEvents to False, EnableEvents get sets back to True before the code finishes.

I can't find any procedures that EnableEvents set to false and not set back to true before the end of the procedure. There are several procedures that set the EnableEvents to true without having it set to false first. Would this impact it?

 

[Peter_SSs]

So if enabling events is set to false, the alert will not be fired off?

Correct. It is part of the Worksheet_Change code That code is triggered by an event. That event being something changed on the worksheet. If events are disabled than changing something on the worksheet does not trigger the code.

I can't find any procedures that EnableEvents set to false and not set back to true before the end of the procedure.

I showed you in post 9 one case where that can happen.

 

[dpaton05]

I am trying to get this working on my quote sheet and the code at the bottom of post #9 is not in the change event for the quote sheet.

The on change event for the quote sheet is

Private Sub Worksheet_Change(ByVal Target As Range)
'ActiveSheet.Unprotect
        Dim ans As String
        If Not Intersect(Target, Range("A:A,B:B")) Is Nothing Then
        Application.EnableEvents = False
        Select Case Target.Column
            Case Is = 1
                'If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
                If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then
                    Application.EnableEvents = True
                    Exit Sub
                End If
                
                
                If Target.Value < Date Then
                    If MsgBox("This input is older than today !....Are you sure that is what you want ???", vbYesNo) = vbNo Then
                        Target.Value = ""
                    End If
                End If
            Case Is = 2
                If Target = "Activities" Then
                    Do
                        ans = InputBox("Please enter the Activities cost." & _
                        vbCrLf & "************************************" & vbCrLf & _
                        "To change an activity cost, select Activities from the Service list again.")
                        If ans <> "" Then
                            Cells(Target.Row, "N") = ans
                            Exit Do
                        Else
                            MsgBox ("You must enter a Activities cost.")
                        End If
                    Loop
                End If
            
        End Select
        End If
    Application.EnableEvents = True
'ActiveSheet.Protect
End Sub

And this is the on change event for the costing_tool, which I don't need the procedure for.

Private Sub Worksheet_Change(ByVal Target As Range)
'Worksheets("Costing_tool").Unprotect

    Dim ans As String
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
    'If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then
        Application.EnableEvents = True
        Exit Sub
    End If
    
        If Target.Value < Date Then
            ans = MsgBox("This input is older than today !....Are you sure that is what you want ???", vbYesNo)
        If ans = vbNo Then Target.Value = ""
        End If
    End If

    Application.EnableEvents = True
'Worksheets("Costing_tool").Protect
End Sub

Do I need to take some bits from this procedure and put them in the on change event for the quote sheet?

 

[Peter_SSs]

I am trying to get this working on my quote sheet and the code at the bottom of post #9 is not in the change event for the quote sheet.

Hmm, the code in post #1 was for the Costing-tool sheet so I thought this thread was about that sheet.

Anyway, it doesn't matter as the issue is exactly the same as what I described in post 9. Your 'Delete All Lines' code for the Quote sheet makes changes to that sheet, including in column A. As soon as that happens the Quote sheet Worksheet_Change code is triggered. An extract of that code is reproduced below.

Events are disabled (blue)
The 'Target' is empty because the Delete All Lines Code emptied all the data (red)
So the Sub is exited (green)
That means the code never gets to the part where Events are re-enabled (pink)

So now if you go back to the sheet and enter a date (or anything else) the Worksheet_Change 'event' does not trigger because all 'Events' are still disabled.

The on change event for the quote sheet is

Private Sub Worksheet_Change(ByVal Target As Range)
'ActiveSheet.Unprotect
        Dim ans As String
        If Not Intersect(Target, Range("A:A,B:B")) Is Nothing Then
        [COLOR="#0000FF"][B][SIZE=4]Application.EnableEvents = False[/SIZE][/B][/COLOR]
        Select Case Target.Column
            Case Is = 1
                '[COLOR="#FF0000"][B][SIZE=4]If[/SIZE][/B][/COLOR] Target.Cells.CountLarge > 1 Or [COLOR="#FF0000"][B][SIZE=4]IsEmpty(Target)[/SIZE][/B][/COLOR] Then [B][SIZE=4][COLOR="#008000"]Exit Sub[/COLOR][/SIZE][/B]
                If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then
            
.
.
.
.


        End If
    [COLOR="#EE82EE"][B][SIZE=4]Application.EnableEvents = True[/SIZE][/B][/COLOR]
'ActiveSheet.Protect
End Sub

So, as I said before: "What you do need to do is very carefully check that every time you set EnableEvents to False, EnableEvents get sets back to True before the code finishes."
That doesn't say check each procedure to see if there is a line to re-enable events. You have to check that whatever happens in the code, it actually gets to a line that re-enables events.