A msg box only sometimes alerts on earlier date entered

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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:
Code:
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
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
With the code you have posted, If a date is being entered anywhere in Col "A" the message should appear IF the date is older than today !!
 
Upvote 0
If you select the delete all lines button it won't show the message box when an earlier date on the empty line is entered either.

Here is the delete Lines code:

Code:
Sub cmdDeleteAllQuoteLines()
    'Deleting The Data In A Table
    Dim tbl As ListObject
    Dim cell As Range
    
    Set tbl = Sheets("NPSS_quote_sheet").ListObjects("npss_quote")
    'Delete all table rows except first row
    With tbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete

        End If
        'Clear the contents, but not delete the formulas
        For Each cell In tbl.ListRows(1).Range.Cells
            If Not cell.HasFormula Then
                cell.Value = ""
            End If
        Next
    End With
        With ThisWorkbook.Worksheets("NPSS_quote_sheet")
            .ListObjects("npss_quote").DataBodyRange.Columns(13).Value = 1 - 0.1 * ActiveSheet.chkIncrease.Value
            .Rows(11).Font.Bold = False
        End With
            
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
End Sub

Any help would be greatly appreciated.
 
Upvote 0
Is there somewhere else I should put it so that it is running all the time as the code is only triggered at certain times, such as the worksheet being changed, but what about if the worksheet is opened and the date entered? The message box will not be entered here.
 
Last edited:
Upvote 0
I had an idea. I put the code in its own procedure and I thought I could just call it from the other procedures that I was having the problems with it.

Code:
Sub cmdOlderToday()
    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
End Sub


But I tried that and I got the error message with this code Sub or function not defined and it highlighted the line
Code:
call cmdOlderToday

Within my procedure:

Code:
Private Sub cmdDeleteQuoteLines_Click()
ActiveSheet.Unprotect
    Call cmdDeleteAllQuoteLines
    Call cmdOlderToday
'ActiveSheet.Protect
End Sub
 
Upvote 0
but what about if the worksheet is opened and the date entered?
If you open the worksheet that has the code attached to it....it will fire every time column "A" is changed. ??
 
Upvote 0
It does but if you select the button to delete all lines, it will not appear if entered in the first row after the deletion.
 
Upvote 0
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 !

Code:
Sub cmdDeleteAllQuoteLines()
    'Deleting The Data In A Table
    Dim tbl As ListObject
    Dim cell As Range
    
    Set tbl = Sheets("NPSS_quote_sheet").ListObjects("npss_quote")
    'Delete all table rows except first row
    With tbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete

        End If
        'Clear the contents, but not delete the formulas
        For Each cell In tbl.ListRows(1).Range.Cells
            If Not cell.HasFormula Then
                cell.Value = ""
            End If
        Next
    End With
        With ThisWorkbook.Worksheets("NPSS_quote_sheet")
            .ListObjects("npss_quote").DataBodyRange.Columns(13).Value = 1 - 0.1 * ActiveSheet.chkIncrease.Value
            .Rows(11).Font.Bold = False
        End With
            
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
End Sub
 
Upvote 0
If you select the delete all lines button it won't show the message box when an earlier date on the empty line is entered either.

Here is the delete Lines code:

Code:
Sub cmdDeleteAllQuoteLines()
    'Deleting The Data In A Table
    Dim tbl As ListObject
    Dim cell As Range
    
    Set tbl = Sheets("NPSS_quote_sheet").ListObjects("npss_quote")
    'Delete all table rows except first row
    With tbl.DataBodyRange
        [COLOR="#FF0000"][B]If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete[/B][/COLOR]

        End If
In relation to this issue, your problem begins with the red lines above.
Since they are changing what is on the worksheet, the Worksheet_Change code is triggered.
In that procedure you have the following
Rich (BB code):
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
    If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Because rows were deleted there is an intersection between Target and column A
So EnableEvents is set to False
Then you have this red bit which is True (because the rows are now all empty) so the Sub is exited with EnableEvents still set to False

Therefore, next time you enter something on the sheet, the Worksheet_Change (event) is not triggered.
 
Upvote 0
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?
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top