Excel VBA If Then Else losing date format on first worksheet in Count - vba

Question

I have written some Excel VBA to add weekday dates, down column "A", for 41 worksheets. The dates build to 90 days out and then have a "Beyond mm/dd/yy" text value in the following cell. The code is run every weekday, with the exception of holidays, and builds the dates over the cell that was previously the text cell. This process works beautifully, except for the first of 41 worksheets, where the added date(s) display as text, even though their "format" will say they are a date. The other 40 display as dates. I have attempted to wrap my calculated dates in CDate() and DateValue(), and both. The closes I came was copying down the above cell, but then I will get non-weekdays, as Excel builds the next autofill. I even tried to revisit the one worksheet with the issue and roll through the IF Then Else again, but, with a defined value for the "Beyond" text row and then reassign the dates - this yielded the same result; so, I have concluded that the issue is likely related to how I have written the IF Then Else portion.
Thank you for any ideas~
Dim count As Integer
Sheets("ABCD").Activate
For count = 1 To 41
'*************************************************************************** ********************
'Inserts Dates for weekdays, until 90 days out, then a "Beyond MM/DD/YY" value for the last date
'***********************************************************************************************
Dim ThisSheet As String
'turn off auto formula calculation
Application.Calculation = xlManual
Range("A1").Activate
'find the current "Beyond" date cell
Columns("A:A").Select
Selection.Find(What:="Beyond", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("A" & ActiveCell.Row).Select
'Add business days to column(A:A) until the next business day would be 91 days or greater
Do Until ((Weekday(Range("A" & ActiveCell.Row - 1)) = 6) And _
(DateAdd("w", 3, Range("A" & ActiveCell.Row - 1))) >= (DateAdd("d", 91, Date))) Or _
((Weekday(Range("A" & ActiveCell.Row - 1)) <> 6) And _
(DateAdd("d", 1, Range("A" & ActiveCell.Row - 1))) >= (DateAdd("d", 91, Date)))
If Weekday(Range("A" & ActiveCell.Row - 1)) = 6 Then
ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell.Value = DateValue(DateAdd("w", 3, Range("A" & (ActiveCell.Row - 1))))
Selection.NumberFormat = "m/d/yyyy"
ElseIf Weekday(Range("A" & ActiveCell.Row - 1)) = 7 Then
ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell.Value = DateValue(DateAdd("w", 2, Range("A" & (ActiveCell.Row - 1))))
ActiveCell.Select
Selection.NumberFormat = "m/d/yyyy"
Else: ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell.Value = DateValue(DateAdd("w", 1, Range("A" & (ActiveCell.Row - 1))))
ActiveCell.Select
Selection.NumberFormat = "m/d/yyyy"
End If
Selection.Offset(1, 0).Activate
Loop
'Add in the "Beyond" date, to column(A:A)
ActiveCell.Value = "Beyond " & Format((DateAdd("d", 90, Date)), "mm/dd/yy")
Range("A1").Select
'*****************************************************************************************
'****************************************************************
'Copies down formulas to the last date or "Beyond MM/DD/YYYY" row
'****************************************************************
'Set LastRow Value for end of desired formula range
LTCashSheet_LastRow = Range("A" & Rows.count).End(xlUp).Row
'Set LastRow Value for beginning formulas to copy down
LTCashSheet_BegCopyRange = Range("B" & Rows.count).End(xlUp).Row
Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_BegCopyRange).Select
Selection.AutoFill Destination:=Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_LastRow), Type:=xlFillDefault
Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_LastRow).Select
Columns("A:A").AutoFit
'****************************************************************
'****************************************************************
'Hide Rows 11 through rows prior to today's date row*************
'****************************************************************
Set TheRng = Range("A1", Range("A" & Rows.count).End(xlUp))
CurrDtRow = TheRng.Find(What:=Date, LookAt:=xlWhole).Row
Rows("11:" & (CurrDtRow - 2)).Select
Selection.EntireRow.Hidden = True
Range("A1").Select
'****************************************************************
'Go to next sheet and repeat, through 'count'********************
ActiveSheet.Next.Select
Next count

Answer 1

I found helpful information from Excel VBA date formats. I did not integrate the solution to prevent the above from happening, within my IF THEN ELSE; however, I was able to add some clean up using the function and applying the code to the cells immediately above the "Beyond" value, which were the cells that were a strange hybrid of a String and a Date. I am good to go, but, feel free to comment if you think I should have gone a different route.
Thank you!
Function CellContentCanBeInterpretedAsADate(cell As Range) As Boolean
Dim d As Date
On Error Resume Next
d = CDate(cell.Value)
If Err.Number <> 0 Then
CellContentCanBeInterpretedAsADate = False
Else
CellContentCanBeInterpretedAsADate = True
End If
On Error GoTo 0
End Function
Sub FixDtFrmtWithFnctn()
Dim cell As Range
Dim cvalue As Double
Sheets("NCE1").Select
Set TheRng4 = Range("A1", Range("A" & Rows.count).End(xlUp))
DtFrmtFixRow = TheRng4.Find(What:=("Beyond"), LookAt:=xlPart).Row
Set cell = Range("A" & (DtFrmtFixRow - 1))
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = CDate(cell.Value)
cell.Value = cvalue
cell.NumberFormat = "m/d/yyyy"
Else
cell.NumberFormat = "General"
End If
Set cell = Range("A" & (DtFrmtFixRow - 2))
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = CDate(cell.Value)
cell.Value = cvalue
cell.NumberFormat = "m/d/yyyy"
Else
cell.NumberFormat = "General"
End If
Set cell = Range("A" & (DtFrmtFixRow - 3))
If CellContentCanBeInterpretedAsADate(cell) Then
cvalue = CDate(cell.Value)
cell.Value = cvalue
cell.NumberFormat = "m/d/yyyy"
Else
cell.NumberFormat = "General"
End If
End Sub