Input date if Date + 30 days < current month and year

[howard]

I have the following code below


I would like the input box to appears to input the date only if the date in A3 on sheet BR1 +30 < date
, otherwise exit sub

It would be appreciated if someone could amend my code

  Sub Date_Input()
Sheets("Sales").Select
Dim MyDate As String
Range("a3").Select
If Range("A3") + 30 > Now() Then
Exit Sub
Else
End If

ActiveCell.FormulaR1C1 = InputBox("Enter the current Month and year for eg June 2006")

Sheets(1).Select
End Sub

 

[Joe4]

So, are you trying to replace the existing value in cell A3 with that condition is met?

Do you realize that if you just enter the month and year of a date, it will automatically assign a day value of "1" to that date?
Is that OK?

How is this code being called to run?

 

[howard]

Hi Joe

I have an existing date in A3 (format dd/mm/yyyy). If A3 is say 30/04/2019 + 30 days is 30/05/2019 and the current date is 21/05/2019 then date not to change i.e exit sub, otherwise date to be inputted using inputbox to change the date in A3

 

[Joe4]

But you mention two sheets, "BR1" and "Sales". Your description and code seem to conflict with each other.
Which sheet are you checking the date on?
Which sheet are you wanting to update?

 

[howard]

My Apologies Joe

Just saw my typo now.

Sheet BR1 should sheet "Sales"

 

[Joe4]

Try this. I added a loop, so it will keep asking for a date until a valid one is entered (in case the make a typo).

Sub Date_Input()

    Dim MyDate As Variant
    Dim updated As Boolean

'   Initialize variable
    updated = False

    If Sheets("Sales").Range("A3") + 30 > Date Then
        Exit Sub
    Else
        Do Until updated = True
'           Ask for date
            MyDate = InputBox("Enter the current Month and year for eg June 2006")
'           Check for valid date
            If IsDate(MyDate) Then
                Sheets("Sales").Range("A3") = MyDate
                updated = True
            End If
        Loop
    End If

End Sub

 

[howard]

Thanks very much Joe

Code works perfectly

 

[Joe4]

You are welcome.