To All,
I have the following code and have been using the trial and error
method to trap invalid dates with limited success. Most cells on this
particular worksheet are calculated cells that pull information from
different worksheets using the date entered. If I enter an invalid date
all formula's turn to #REF and my code to hide blank cells error's out
and I have to manually force recalculation after fixing the date.

I wont the code to fire only when the date in I1 is changed and
before committing the date to the cell check to make sure that it is
valid and if it is not enter Today's date and display a message that the
date entered is invalid and then go back to I1 so that the date can be
reentered.

I did some searches came up with some of the code below, but I am
cobbling it together and probably do not have the logic correct. Can
someone take a look at the code and point out where I may be going wrong?

Thanks
Harry

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("I1") Then
If Not IsDate(Range("I1")) Then
Application.EnableEvents = False
Range("I1").Value = "1/1/08"
MsgBox ("You entered an invalid date! Please correct"), vbInformation
Application.EnableEvents = True
Exit Sub
Else
'HIDE ROWS BLANK ROWS ON SHEET
Application.ScreenUpdating = False
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
ActiveSheet.Protect Contents:=True, UserInterfaceOnly:=True
Sheets("Income Stmt").Select
With ActiveSheet.UsedRange
.Rows.Hidden = False
For Each Cell In Range("B17:B42")
If Cell.Value = "" Or Cell.Value = 0 Then _
Cell.EntireRow.Hidden = True
Next Cell
End With
With ActiveSheet.UsedRange
For Each Cell In Range("B4:B14")
If Cell.Value = "" Then _
Cell.EntireRow.Hidden = True
Next Cell
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End If
End Sub