I'm not the best VBA programmer - that is why I was hoping that someone with
more skills would jump in - but try this code:
Option Explicit
Sub TestDate()
Dim InDate As String
Dim Idate As Long
Dim EDate As Long
Dim Ans As Integer
Dim eEDate As Long
Dim NexDate As Long
Dim ExDate As String
Dim EYear As Long
Dim EMonth As Long
Dim LastRow As Long
InDateInput:
On Error GoTo 0
InDate = _
InputBox("Please enter the date of the " & _
"Test in the format d-mmm-yy", "Test Date")
'Change the dd/mm/yy to the date system you use
On Error Resume Next
If IsError(DateValue(InDate)) Then
MsgBox "I don't recognise that as a date" & vbLf & _
"Please try again"
GoTo InDateInput
End If
Idate = DateValue(InDate)
Ans = MsgBox("Test Date was: " & _
Format(Idate, "d-mmm-yy") & vbLf & _
"Is That correct?", vbYesNo, "Test Date")
'Change the Format to the date format that you use
If Ans = 7 Then GoTo InDateInput
ExDateInput:
On Error GoTo 0
ExDate = _
InputBox("Please enter the date of the last " & _
"Expiry in the format dd-mmm-yy", "Expiry Date")
'Change the dd/mm/yy to the date system you use
On Error Resume Next
If IsError(DateValue(ExDate)) Then
MsgBox "I don't recognise that as a date" & vbLf & _
"Please try again"
GoTo ExDateInput
End If
EDate = DateValue(ExDate)
Ans = MsgBox("Last Expiry Date is: " _
& Format(EDate, "d-mmm-yy") & vbLf & _
"Is That correct?", vbYesNo, "Expiry Date")
'Change the Format to the date format that you use
If Ans = 7 Then GoTo ExDateInput
EYear = Year(EDate): EMonth = Month(EDate) - 2
eEDate = DateValue(1 & "/" & EMonth & "/" & EYear)
If Idate > EDate Then
MsgBox "There is a mistake in one of the dates" & vbLf & _
"Please start again", , "Date Error!"
GoTo InDateInput
End If
If eEDate >= Idate Then
MsgBox "You have taken the Test too early", _
, "Test taken too soon"
Exit Sub
End If
EMonth = Month(EDate) + 7
If EMonth > 12 Then
EMonth = EMonth - 12
EYear = EYear + 1
End If
NexDate = DateValue(1 & "/" & EMonth & "/" & EYear)
NexDate = NexDate - 1
MsgBox "New Expiry Date is: " _
& Format(NexDate, "d-mmm-yy"), , "New Expiry Date"
Ans = MsgBox("Enter the new dates in the Spreadsheet?", _
vbYesNo, "Update Spreadsheet")
If Ans = 6 Then
With ActiveSheet
Columns("A:B").ColumnWidth = 13
Columns("A:B").NumberFormat = "d-mmm-yy"
End With
Cells(1, 1).Value = "Test Date"
Cells(1, 2).Value = "Expiry Date"
LastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(LastRow, 1).Value = Idate
Cells(LastRow, 2).Value = NexDate
End If
End Sub
Note that because the focus is on the *Yes* button just pressing *Enter*
will accept the option and although it says to enter the date in the format
"d-mmm-yy" it also accepts "d/mm/yy"
--
HTH
Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings
(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk
