Entering a date between 2 parameters

[cbs81]

Hi,

I have searched everywhere for the answer but can not get a solutions to my problem..

I have 2 dates in cell A1 & A2 respectively

ie.

1 January 2007
31 January 2007

In column D, I want the user to enter a date in the format dd/mm/yyyy. I have set this up in the format cell properties.. NOW I want the user to enter a date that falls in between cells A1 & A2..... If they enter, say 05/02/2007... I want excel to prompt the user that this is outside parameters and that you must reenter... Do I need some VBA Code to do this.. I tried using validation but cant get it to work...

Basically if the user enters a date OUTSIDE the month in cell a1 to a2 then the user must be prompted to re enter the date...

thankyou

[shasur]

Here is it

[VBA]
Sub Check_Date()

Dim A1Date As Date
Dim A2Date As Date
Dim D1Date As Date
On Error Resume Next
A1Date = Range("A1").Value
A2Date = Range("A2").Value
D1Date = Range("D1").Value
If DateDiff("d", A1Date, D1Date) < 0 Or DateDiff("d", A2Date, D1Date) > 0 Then
MsgBox "Enter a correct date!!!"
End If

End Sub

[/VBA]

Please fine tune if necessary

[mdmackillop]

You could also apply conditional formatting to the cell, for example to turn it red if the data does not fit.

[Bob Phillips]

You can do it with data validation with a type of custom and a formula of

=AND(D1>=A1,D1<=A2)

assuming D1 is the DV cell. You can customise the message to suit.

[cbs81]

Hi there... I have altered the code below to as I want the user to be prompted as sooon as they enter an incorrect date... im a beginner programmer and am having some problems with the below code...

I need the user to be prompted the exact cell that is the problem as and when they enter the date

Any help would be soo appreciated.. thankyou


[VBA]Sub Check_Date()

Dim A1Date As Date
Dim A2Date As Date
Dim D1Date As Date

Dim i As Long
Dim LastRow As Long




'On Error Resume Next


'If Range("aj" & i).Text <> "0" And Range("a" & i).Text = "" Then


'A1Date = Range("A1").Value
'A2Date = Range("A2").Value
'D1Date = Range("D1").Value

If Target.Column <> 4 Then

LastRow = Range("d" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow


If DateDiff("d", A1Date, D1Date) < 0 Or DateDiff("d", A2Date, D1Date) > 0 Then
Prompt = "Enter a correct date!!!"
Title = "Additional Information Required" & Range("d" & i).Address(False, False)
MsgBox Prompt, vbCritical, Title
GoTo ExitSub:
End If
Next i




End If

ExitSub:

End Sub
[/VBA]

[mdmackillop]

Try this Worksheet Module code
[vba]Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1Date As Date
Dim A2Date As Date
Dim D1Date As Date
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column() = 4 Then
A1Date = Range("A1")
A2Date = Range("A2")
D1Date = Target

LastRow = Range("D" & Rows.Count).End(xlUp).Row
If DateDiff("d", A1Date, D1Date) < 0 Or DateDiff("d", A2Date, D1Date) > 0 Then
Prompt = "Enter a correct date!!!"
Title = "Additional Information - " & Target.Address(False, False)
MsgBox Prompt, vbCritical, Title
Target.Select
End If
End If
ExitSub:
End Sub[/vba]

[Bob Phillips]

Why use complex code, when you can use simple DV?