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

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

score 0 · Answer 1 · edited May 23 '17 at 12:00

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

This will work as a workaround, but, it does not answer what the best way would have been to initially write the code so that the formatting issue, on the first worksheet in the loop, does not occur. — HicRhodus, Feb 20 '17 at 15:09

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

1 Answers1