Solved stop date being entered if older than last entered date

July 3, 2013 at 10:40:50
Specs: Windows 7
Sub datepaste1()
'
' datepaste Macro
' unprotect sheet
    Sheets("SCARD").Unprotect Password:="sillybilly"
 nxtRow = Sheets("SCARD").Range("R" & Rows.Count).End(xlUp).Row + 1
   With Sheets("SCARD").Range("R1" & ":R" & nxtRow)
     Set d = .Find(Range("K6"))
      If d Is Nothing Then
        If MsgBox("Is the Competition Date Correct?", vbYesNo Or vbInformation, "Date") = vbYes Then
' Date is Copied and pasted into this range of merged cells
           Range("K6").Copy _
             Destination:=Range("D5:E5")
' date is pasted into the next blank cell in column R
           Sheets("SCARD").Range("K6").Copy _
             Destination:=Sheets("SCARD").Range("R" & nxtRow)
' protect sheet
    Sheets("SCARD").Protect Password:="sillybilly", DrawingObjects:=True, Contents:=True, Scenarios:=True

        Else
           MsgBox "Please re-enter the Correct Date", vbCritical Or vbOKOnly, "Date"
        End If
      Else
        MsgBox "Date Already Exists. Please Try Again", vbCritical Or vbOKOnly, "Date"
        End If
      Else
        MsgBox "Date is BEFORE last Date entered. Please Try Again", vbCritical Or vbOKOnly, "Date"
        End If
   End With
End Sub

The above Vba works very well. I have added the last message box as I need for the date NOT to be entered if it IS OLDER than the last entered date. I am missing a line of instruction and cannot seem to work it out.

Any ideas, ?????


See More: stop date being entered if older than last entered date

Report •

✔ Best Answer
July 11, 2013 at 09:24:44
I believe that this version will do what I think you want. (How's that for confidence?)

It's a bit shorter than your version because it basically does 2 fairly simple things:

It checks the Date that was entered in K6, then either presents a MsgBox that the date is invalid or it copies the date to the 2 cells, D5 and Column R.

You will also notice that the code does not Unprotect the sheet until it has been determined that the date will be copied. Besides being ineffcient to Unprotect the sheet before we know if the sheet will be changed, it is also more dangerous.

Let's assume that the Unprotect instruction is placed before the instruction that checks the date. Now let's assume that the user enters an invalid date. The MsgBox will appear and the code will pause while it waits for the user to click OK. During the pause the sheet is Unprotected because the Unprotect instruction has already been executed. If the user hits Ctrl-Break while the MsgBox is on the screen, he can stop the code. The sheet will then be left Unprotected.

However, if the code doesn't Unprotect the sheet until just before the Date is copied, it would be next to impossible for the user to hit Ctrl-Break during the very brief time that the sheet is Unprotected.

Sub datepaste3()
'
' datepaste Macro

'Determine last row with data in Column R
    lastDateRow = Sheets("SCARD").Range("R" & Rows.Count).End(xlUp).Row

'Date is compared to last date in Column R
    If Sheets("SCARD").Range("K6") <= Sheets("SCARD").Range("R" & lastDateRow) Then
'If Date is invalid, inform User and Exit
      MsgBox ("Date is BEFORE last Date entered, or already Exists. Please Try Again")
        Sheets("SCARD").Range("K6").Select
        Exit Sub
     End If

' If Date is Valid...
' Unprotect sheet
     Sheets("SCARD").Unprotect Password:="sillyboy"
' Date is Copied and Pasted into this rangef merged cells
     Sheets("SCARD").Range("K6").Copy _
        Destination:=Sheets("SCARD").Range("D5:E5")
' Date is Copied and Pasted into the next blank cell in column R
     Sheets("SCARD").Range("K6").Copy _
        Destination:=Sheets("SCARD").Range("R" & lastDateRow + 1)
'Protect sheet
     Sheets("SCARD").Protect Password:="sillyboy", DrawingObjects:=True, _
          Contents:=True, Scenarios:=True

End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
July 3, 2013 at 12:21:07
I don't quite understand why you say "The above Vba works very well" when it produces an error as soon as you try to run it. Code that will not run doesn't "work very well".

All that you have done is add a MsgBox. I don't see where you compare the date entered to the dates in Column R.

Try this:

Sub datepaste1()
'
' datepaste Macro
' unprotect sheet
    Sheets("SCARD").Unprotect Password:="sillybilly"
 nxtRow = Sheets("SCARD").Range("R" & Rows.Count).End(xlUp).Row + 1
   With Sheets("SCARD").Range("R1" & ":R" & nxtRow)
     Set d = .Find(Range("K6"))
      If d Is Nothing Then
        If MsgBox("Is the Competition Date Correct?", vbYesNo Or vbInformation, "Date") = vbYes Then
' Date is Copied and pasted into this range of merged cells
           Range("K6").Copy _
             Destination:=Range("D5:E5")
'Date is compared to last date in Column R
          lastDateRow = nxtRow - 1
            If Range("K6") < Sheets("SCARD").Range("R" & lastDateRow) Then
               MsgBox "Date is BEFORE last Date entered. Please Try Again", _
                   vbCritical Or vbOKOnly, "Date"
            End If
' date is pasted into the next blank cell in column R
           Sheets("SCARD").Range("K6").Copy _
             Destination:=Sheets("SCARD").Range("R" & nxtRow)
' protect sheet
    Sheets("SCARD").Protect Password:="sillybilly", DrawingObjects:=True, Contents:=True, Scenarios:=True

        Else
           MsgBox "Please re-enter the Correct Date", vbCritical Or vbOKOnly, "Date"
        End If
      Else
        MsgBox "Date Already Exists. Please Try Again", vbCritical Or vbOKOnly, "Date"
        End If
   End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
July 3, 2013 at 12:59:24
Sub datepaste2()
'
' datepaste Macro
' unprotect sheet
    Sheets("SCARD").Unprotect Password:="sillyboy"
 nxtRow = Sheets("SCARD").Range("R" & Rows.Count).End(xlUp).Row + 1
 
     'Date is compared to last date in Column R
          lastDateRow = nxtRow - 1
            If Range("K6") < Sheets("SCARD").Range("R" & lastDateRow) Then
               MsgBox "Date is BEFORE last Date entered. Please Try Again", _
                   vbCritical Or vbOKOnly, "Date"
            End If
            
   With Sheets("SCARD").Range("R1" & ":R" & nxtRow)
     Set d = .Find(Range("K6"))
      If d Is Nothing Then
        If MsgBox("Is the Competition Date Correct?", vbYesNo Or vbInformation, "Date") = vbYes Then
' Date is Copied and pasted into this range of merged cells
           Range("K6").Copy _
             Destination:=Range("D5:E5")

' date is pasted into the next blank cell in column R
           Sheets("SCARD").Range("K6").Copy _
             Destination:=Sheets("SCARD").Range("R" & nxtRow)
' protect sheet
    Sheets("SCARD").Protect Password:="sillyboy", DrawingObjects:=True, Contents:=True, Scenarios:=True

        Else
           MsgBox "Please re-enter the Correct Date", vbCritical Or vbOKOnly, "Date"
        End If
      Else
        MsgBox "Date Already Exists. Please Try Again", vbCritical Or vbOKOnly, "Date"
        End If
   End With
End Sub

Sorry saying the VBa worked well, it does before adding the extra MsgBox, and then obviously throws up the error . I tried your Vba and the date still pasted, so I have adjusted your VBa to the above, Basically repositioned it.

What I need for it to do is when you have to hit the 'ok' button, you don't go any further.
With the above, it then comes up with the msgbox "Is the Competition Date Correct?", You can then hit yes and that will post the date whether it is right or not.
When I mean 'any further', I mean that you have to re-enter a date.

Is it the positioning of the instructions or am I missing something silly


Report •

#3
July 3, 2013 at 20:02:51
Before we go any further I'm confused by something in your code.

In what sheet is the "Range("K6") that you are copying?

In this section of code, you refer to K6 without referencing a sheet name:

Set d = .Find(Range("K6"))
      If d Is Nothing Then
        If MsgBox("Is the Competition Date Correct?", vbYesNo Or vbInformation, "Date") = vbYes Then
' Date is Copied and pasted into this range of merged cells
           Range("K6").Copy _
             Destination:=Range("D5:E5")

But here you reference K6 in Sheet("Scard")

' date is pasted into the next blank cell in column R
           Sheets("SCARD").Range("K6").Copy _
             Destination:=Sheets("SCARD").Range("R" & nxtRow)

Obviously the dae can't be entered in SCARD!K6 because the sheet is protected.

How and where is the user entering the date?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
July 5, 2013 at 09:32:16
Hi there, sorry not responded sooner but have had a manic week.

SCARD!K6 is where the User can enter the date. This field is unlocked when the sheet is protected

I assume that because it is the active sheet, (I may be wrong) the code works.

     'Date is compared to last date in Column R
          lastDateRow = nxtRow - 1
            If Range("K6") <= Sheets("SCARD").Range("R" & lastDateRow) Then
               MsgBox "Date is BEFORE last Date entered, or Already Exists. Please Try Again", _
                   vbCritical Or vbOKOnly, "Date"
            End If

So from here, when the msgbox is confirmed 'Ok', I need to go back to the sheet without further msgbox's appearing, so that a date can be re-entered into "K6"

Probably an easy solution, and I might be overthinking on the answer to resolve it.

Your assistance is greatly appreciated


Report •

#5
July 8, 2013 at 19:15:32
As I worked through this, I once again found myself confused. One of your original requests was to not allow a date that already existed in Column R.

Now you are asking to not allow a date prior to the last date in Column R.

It seems to me that if both of those requirements are met, then any date that already exists in Column R must be before the last date in Column R.

e.g. Let's say Column R looks like this:

7/4/2013
7/7/2013
7/12/2013

Originally, you wanted to prevent the user from entering any of those dates. Now you want to prevent the user for entering any date prior to 7/12/2013. Dates prior to 7/12/2013 will include 7/4 and 7/7.

Doesn't that remove the requirement to check for an existing date? Isn't it sufficient to check for any date less than or equal to the last date in Column R?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
July 9, 2013 at 09:35:47
As I said, I have been overthinking ideas and solutions and missing the relatively easier solutions.
You are correct in your diagnosis of what I am trying to do.
Any assistance with the code work would be appreciated, but I am going to try and manipulate what I have already

Report •

#7
July 9, 2013 at 09:54:43
Sub datepaste2()
'
' datepaste Macro
' unprotect sheet
    Sheets("SCARD").Unprotect Password:="sillyboy"
 nxtRow = Sheets("SCARD").Range("R" & Rows.Count).End(xlUp).Row + 1
 
     'Date is compared to last date in Column R
          lastDateRow = nxtRow - 1
            If Sheets("SCARD").Range("K6") <= Sheets("SCARD").Range("R" & lastDateRow) Then
               If MsgBox("Date is BEFORE last Date entered, or already Exists. Please Try Again", vbYesOnly Or vbInformation, "Date") = vbNo Then

' Date is Copied and pasted into this range of merged cells
           Sheets("SCARD").Range("K6").Copy _
             Destination:=Range("D5:E5")

' date is pasted into the next blank cell in column R
           Sheets("SCARD").Range("K6").Copy _
             Destination:=Sheets("SCARD").Range("R" & nxtRow)
' protect sheet
    Sheets("SCARD").Protect Password:="sillyboy", DrawingObjects:=True, Contents:=True, Scenarios:=True

        Else
           MsgBox "Please re-enter the Correct Date", vbCritical Or vbOKOnly, "Date"
        End If
        
' protect sheet
    Sheets("SCARD").Protect Password:="sillyboy", DrawingObjects:=True, Contents:=True, Scenarios:=True

        End If
End Sub

DerbyDad03, a big thank you for pointing out the error of my ways. After a little tinkering, I came up with the above which basically does what I require.

Again many thanks


Report •

#8
July 9, 2013 at 11:35:17
I don't see how your latest version of the code works for you. Unless I am entering something incorrectly, it doesn't do what I think you want.

I created a sheet named SCARD. I entered this in R1:R2:

        R
1     Date
2   7/1/2013

In K6 I entered 7/4/2013, which I assume is a valid date.

I went into the VBA editor and pressed F8 to single step through the code.

Since the date in K6 is greater than the last date in Column R, this statement is FALSE:

If Sheets("SCARD").Range("K6") <= Sheets("SCARD").Range("R" & lastDateRow) Then

Since that statement is FALSE, the code jumped down to the End If before the End Sub. Nothing was copied and the sheet remained Unprotected.

Is it me or is it the code?

Two other points:

1 - You are Unprotecting the sheet before you even check the date. It's a minor issue, but I prefer not to Unprotect a sheet until I am sure that I am going to write something to it. I then Protect the sheet immediately after the changes are made. Why waste the resources to Unprotect and then Protect the sheet if the input is such that you aren't going to use it?

My guess is that once you get the code working, you will only need one Protect instruction, not the 2 that you have now.

2 - If the date entered is invalid, you present a MsgBox that tells the user to "...Please Try Again." When the user clicks OK, you present another MsgBox telling the user to "Please re-enter the Correct Date". Personally, I don't see the need to tell the user twice that he needs to enter a different date.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#9
July 11, 2013 at 07:33:26
Hi there DerbyDad03,
I was so intent on sorting out the 'if date is <= the last date , that I completely ignored the fact that the macro does not perform the tasks if the date is correct.
I need to play around with this and suss out what I need to do.

Good way to learn how the VBA's work, but if you have a solution, please share


Report •

#10
July 11, 2013 at 09:24:44
✔ Best Answer
I believe that this version will do what I think you want. (How's that for confidence?)

It's a bit shorter than your version because it basically does 2 fairly simple things:

It checks the Date that was entered in K6, then either presents a MsgBox that the date is invalid or it copies the date to the 2 cells, D5 and Column R.

You will also notice that the code does not Unprotect the sheet until it has been determined that the date will be copied. Besides being ineffcient to Unprotect the sheet before we know if the sheet will be changed, it is also more dangerous.

Let's assume that the Unprotect instruction is placed before the instruction that checks the date. Now let's assume that the user enters an invalid date. The MsgBox will appear and the code will pause while it waits for the user to click OK. During the pause the sheet is Unprotected because the Unprotect instruction has already been executed. If the user hits Ctrl-Break while the MsgBox is on the screen, he can stop the code. The sheet will then be left Unprotected.

However, if the code doesn't Unprotect the sheet until just before the Date is copied, it would be next to impossible for the user to hit Ctrl-Break during the very brief time that the sheet is Unprotected.

Sub datepaste3()
'
' datepaste Macro

'Determine last row with data in Column R
    lastDateRow = Sheets("SCARD").Range("R" & Rows.Count).End(xlUp).Row

'Date is compared to last date in Column R
    If Sheets("SCARD").Range("K6") <= Sheets("SCARD").Range("R" & lastDateRow) Then
'If Date is invalid, inform User and Exit
      MsgBox ("Date is BEFORE last Date entered, or already Exists. Please Try Again")
        Sheets("SCARD").Range("K6").Select
        Exit Sub
     End If

' If Date is Valid...
' Unprotect sheet
     Sheets("SCARD").Unprotect Password:="sillyboy"
' Date is Copied and Pasted into this rangef merged cells
     Sheets("SCARD").Range("K6").Copy _
        Destination:=Sheets("SCARD").Range("D5:E5")
' Date is Copied and Pasted into the next blank cell in column R
     Sheets("SCARD").Range("K6").Copy _
        Destination:=Sheets("SCARD").Range("R" & lastDateRow + 1)
'Protect sheet
     Sheets("SCARD").Protect Password:="sillyboy", DrawingObjects:=True, _
          Contents:=True, Scenarios:=True

End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#11
July 11, 2013 at 13:20:36
Your confidence is well founded. I have run a quick test and all looks ok.
Truly amazing and another example of your genius.
Some instructions that I have not seen before, but am beginning to understand how to write the coding and manipulate it

Many thanks for your help, and look out for my next one, I will be testing the grey matter further


Report •

Ask Question