Fix dates when populating on worksheet

[YasserKhalil]

Hello everyone
I have a date in cell A1 and this code supposed to list the dates for this date in cell A1

Code: Select all

Sub Test()
    Dim dDays() As Date, iYear As Long, iMonth As Long, DaysInMonth As Long, i As Long
    iYear = Year(Range("A1").Value2)
    iMonth = Month(Range("A1").Value2)
    DaysInMonth = CLng(DateSerial(iYear, iMonth + 1, 1)) - CLng(DateSerial(iYear, iMonth, 1))
    ReDim dDays(1 To DaysInMonth)
    For i = 1 To DaysInMonth
        dDays(i) = CDate(CLng(DateSerial(iYear, iMonth, i)))
    Next i
    Range("F1").Resize(UBound(dDays)).Value = Application.Transpose(dDays)
End Sub

When inspecting by F8 key, the results are correct and everything is OK
The date in A1 is 1 October 2021 ( 1 / 10 / 2021)
but as for results, I got the dates reversed for days and months so I got the first date 10 of Jan

The weird is that it is correct when testing the dates in the immediate window

[HansV]

Check the number format of F1:F31.

[SpeakEasy]

Your problem here is how Transpose handles type conversion - and over which you do not have direct control.

To work around this change your declaration of dDays() from

Dim dDays() As Date

to

Dim dDays() As Long ' or Variant


And change the format of Column F to Date

[YasserKhalil]

Thank you very much. Changing the variable to long makes the results correct
Best Regards

[Doc.AElstein]

Another thing to try, maybe.
I don’t know how this behaves, but maybe worth a try.
Alternative way to transpose 1 D array to list in 1 column

Code: Select all

 Let Range("F1").Resize(UBound(dDays()), 1).Value = Application.Index(dDays(), Evaluate("=row(1:" & UBound(dDays()) & ")/row(1:" & UBound(dDays()) & ")"), Evaluate("=row(1:" & UBound(dDays()) & ")"))

[YasserKhalil]

Thanks a lot, Alan
But is that will make difference in speed or efficiency ..?

[Doc.AElstein]

I don’t know. Prpbably not much difference, but usually that sort or Evaluate Index is quite fast, especially for a single row or single column .
I suggested it only just because thought it was worth a try see if it solved your problem.

( I personally do not like using the Excel VBA Transpose, since there are sometime problems with it)

[YasserKhalil]

Thanks a lot, Mr. Alan. But this tip is away from solving the main problem
The problem was solved by changing the variable from Date to Long

[Doc.AElstein]

I don’t quite understand what you mean by that.
Your main problem was caused by using the VBA Transpose function
This is an alternative way to do the transpose. I do not know if using this alternative way might solve that main problem.
It was just suggested as another possibility for you to try to solve the main problem

This tip is not away from solving the main problem. It might solve the main problem. It might not. I would have expected you to try it

_.____________________

Your problem here is how Transpose handles type conversion

So, Main problem is the transpose …

...I suggested it only just because thought it was worth a try see if it solved your problem.....

...
I don’t know how this behaves, but maybe worth a try.
Alternative way to transpose 1 D array to list in 1 column....

Get it ??

[HansV]

An alternative:

Code: Select all

Sub Test()
    Dim dDays() As Date, iYear As Long, iMonth As Long, DaysInMonth As Long, i As Long
    iYear = Year(Range("A1").Value2)
    iMonth = Month(Range("A1").Value2)
    DaysInMonth = Day(DateSerial(iYear, iMonth + 1, 0))
    ReDim dDays(1 To DaysInMonth, 1 To 1)
    For i = 1 To DaysInMonth
        dDays(i, 1) = DateSerial(iYear, iMonth, i)
    Next i
    With Range("F1").Resize(DaysInMonth)
        .Value = dDays
        .NumberFormat = "m/d/yyyy" ' System short date format
    End With
End Sub

[YasserKhalil]

Thank you, my tutor. The code you posted generate ###### which means Dates and times that are negative or too large show as ####
I have widen the column width but stills the same so these dates in that case are invalid for me (I know it is working for you)

Sorry: there was an error from my side as I tried the code on another worksheet which has no valid date in cell A1
I tried it and it worked well too

[YasserKhalil]

@Mr. Alan
Yes, you are right. And I already tried your trick but doesn't solve the problem of dates.

[Doc.AElstein]

A Pretty way then, maybe like

Code: Select all

Sub Beautiful()
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """-""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Range("A1").Value2 & ")")
End Sub

Full workings-

Code: Select all

Sub PrettyWay()  '  http://www.eileenslounge.com/viewtopic.php?p=289570#p289570
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim MunfDays As Long
 Let MunfDays = Ws.Evaluate("=DAY(EOMONTH($A$1,0))"): Debug.Print MunfDays     '   31
 Let MunfDays = Ws.Evaluate("=DAY(EOMONTH(" & Ws.Range("A1").Value2 & ",0))"): Debug.Print MunfDays   '   31

Dim arrDts() As Variant, strEval As String
 Let strEval = "=DAY(ROW(1:31))" & "&" & """-""" & "&" & "MONTH($A$1)" & "&""-""&" & "YEAR($A$1)": Debug.Print strEval     '  =DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1)
 Let arrDts() = Ws.Evaluate(strEval)
 Let strEval = "=DAY(ROW(1:31))" & "&" & """-""" & "&" & "MONTH($A$1)" & "&""-""&" & "YEAR($A$1)": Debug.Print strEval     '    =DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1)
 Let arrDts() = Ws.Evaluate(strEval)
 Let strEval = "=DAY(ROW(1:31))" & "&" & """-""" & "&" & "MONTH(" & Ws.Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Ws.Range("A1").Value2 & ")": Debug.Print strEval  '  =DAY(ROW(1:31))&"-"&MONTH(44470)&"-"&YEAR(44470)
 Let arrDts() = Ws.Evaluate(strEval)
 Let strEval = "=DAY(ROW(1:" & MunfDays & "))" & "&" & """-""" & "&" & "MONTH($A$1)" & "&""-""&" & "YEAR($A$1)": Debug.Print strEval   '    =DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1)
 Let arrDts() = Ws.Evaluate(strEval)
 Let strEval = "=DAY(ROW(1:" & MunfDays & "))" & "&" & """-""" & "&" & "MONTH(" & Ws.Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Ws.Range("A1").Value2 & ")": Debug.Print strEval    '     =DAY(ROW(1:31))&"-"&MONTH(44470)&"-"&YEAR(44470)
 Let arrDts() = Ws.Evaluate(strEval)
 Let strEval = "=DAY(ROW(1:" & Ws.Evaluate("=DAY(EOMONTH($A$1,0))") & "))" & "&" & """-""" & "&" & "MONTH(" & Ws.Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Ws.Range("A1").Value2 & ")": Debug.Print strEval    '    =DAY(ROW(1:31))&"-"&MONTH(44470)&"-"&YEAR(44470)
 Let arrDts() = Ws.Evaluate(strEval)
 Let strEval = "=DAY(ROW(1:" & Ws.Evaluate("=DAY(EOMONTH(" & Ws.Range("A1").Value2 & ",0))") & "))" & "&" & """-""" & "&" & "MONTH(" & Ws.Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Ws.Range("A1").Value2 & ")": Debug.Print strEval    '     =DAY(ROW(1:31))&"-"&MONTH(44470)&"-"&YEAR(44470)
 Let arrDts() = Ws.Evaluate(strEval)

 Let Range("F1:F" & MunfDays & "").Value = arrDts()
 Let Range("F1:F" & Ws.Evaluate("=DAY(EOMONTH(" & Ws.Range("A1").Value2 & ",0))") & "").Value = arrDts()
 Let Range("F1:F" & Ws.Evaluate("=DAY(EOMONTH(" & Ws.Range("A1").Value2 & ",0))") & "").Value = Ws.Evaluate(strEval)
 Let Range("F1:F" & Ws.Evaluate("=DAY(EOMONTH(" & Ws.Range("A1").Value2 & ",0))") & "").Value = Ws.Evaluate("=DAY(ROW(1:" & Ws.Evaluate("=DAY(EOMONTH(" & Ws.Range("A1").Value2 & ",0))") & "))" & "&" & """-""" & "&" & "MONTH(" & Ws.Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Ws.Range("A1").Value2 & ")")

End Sub

Something like {DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1)} is the “CSE type 2 formula” thing that you would use for the whole range,
Like select F1:F31 then put something like =DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1) in the formula bar then do the CSE thing, ( or maybe don’t do the CSE if you have a newest Excel version )

[YasserKhalil]

Thanks a lot for your great efforts
I tried each variation of the code you posted and all resulted in such a result

Untitled.png

Note that the first date is translated as 11 Jan. while it should be 1st of Nov.

[YasserKhalil]

The only solution that worked for me is the formula

Code: Select all

=IFERROR(DATEVALUE(DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1)),"")

[Doc.AElstein]

Can you show me please:
_ exactly what you have in cell A1
and
_ exactly what you want, based on what is in cell A1

( As almost always with dates there are often inconsistancies in different Excels since we usually have different settings All my macros work in my Excel, but it does not surpride me that they may not work in all Excels )

[YasserKhalil]

I wonder why this doesn't work as formula did

Code: Select all

Sub Beautiful()
 Let Range("K1:K" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """-""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""-""&" & "YEAR(" & Range("A1").Value2 & ")")
End Sub

This is in cell A1 (1st of Nov. 2021)

Untitled.png

And what I expect is like in column J

Untitled.png

[Doc.AElstein]

I expect you will often get different results to me because we have different settings. These sort of date format inconsitancies always crop up

Maybe one of these will work for you. Most of them work in my Excel. I expect different results will be got with different Excels

Code: Select all

'                                                                                            DATEVALUE(DAY(ROW(1:31))&"-"&MONTH($A$1)&"-"&YEAR($A$1))
Sub ToBeautiful()
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=IF({1},DATEVALUE(DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")))")
End Sub
Sub ItsBeautiful()
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "@"
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=IF({1},DATEVALUE(DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")))")
End Sub


Sub Beautiful2()
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "@"
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
End Sub

Sub Beauty()
Dim Rng As Range: Set Rng = Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "")
 Rng.NumberFormat = "@"
 Let Rng.Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
Dim ACel As Range, Txt As String: Let Txt = "Beautiful "
    For Each ACel In Rng
     RSet Txt = ACel.Value
     Let ACel.Value = Replace(Txt, " ", "0", 1, 1, vbBinaryCompare)
    Next ACel
End Sub

Sub arrBeauty()
Dim Rng As Range: Set Rng = Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "")
 Rng.NumberFormat = "@"
Dim arrRng() As Variant: Let arrRng() = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
Dim Txt As String: Let Txt = "Beautiful "
Dim Cnt as Long
    For Cnt = 1 To UBound(arrRng(), 1)
     RSet Txt = arrRng(Cnt, 1)
     Let arrRng(Cnt, 1) = Replace(Txt, " ", "0", 1, 1, vbBinaryCompare)
    Next Cnt

 Let Rng.Value = arrRng()
End Sub

Sub arrBeauty2()
Dim Rng As Range: Set Rng = Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "")
 Rng.NumberFormat = "@"
Dim arrRng() As Variant: Let arrRng() = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
Dim Txt As String: Let Txt = "Beautiful "
Dim Cnt As Long, arrStrRng() As String: ReDim arrStrRng(1 To UBound(arrRng(), 1), 1 To 1)
    For Cnt = 1 To UBound(arrRng(), 1)
     RSet Txt = arrRng(Cnt, 1)
     Let arrStrRng(Cnt, 1) = Replace(Txt, " ", "0", 1, 1, vbBinaryCompare)
    Next Cnt

 Let Rng.Value = arrStrRng()
End Sub

( Hans macro gives me the correct dates in my Excel, but it does not give me them in the format that you want )

I expect the only way you can ever get a bullet proof result in Excel for consistent date formats in different Excel versions, is to end up building up strings looking exactly as you want the dates to look, and then formatting the cells as text to stop Excel deciding at some point to change what you see. That is what my last 2 above macros do

[YasserKhalil]

Thank you very much.
In fact, I tested most variations and all is ok but please stick to only one approach and I found the following is the simplist

Code: Select all

Sub Beautiful_VIP()
    Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "@"
    Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
End Sub

But as you mentioned, you have formatted the output as text and not as dates (and I need the real dates). Is there an easy way to convert the dates to real dates?

[Doc.AElstein]

If I may, I might like to make one last mod to the last macros, this will make sure you have always 10 characters:

Code: Select all

Sub Beautifully()
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "@"
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=If({1},REPLACE(""0000000000"",11-LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))")
End Sub

Sub BeautifullyDone()
    With Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "")
     Let .NumberFormat = "@"
     Let .Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
     Let .Value = Evaluate("=If({1},REPLACE(""0000000000"",11-LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))")
    End With
End Sub

_.__________________________________________________________________________________________________________________________________________________________________________________________________________________________-

you have formatted the output as text and not as dates (and I need the real dates). Is there an easy way to convert the dates to real dates?

As for the final date format. I am not sure …_
_....Maybe this will work

Code: Select all

Sub BeautifullyDoneAgain()
    With Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "")
     Let .NumberFormat = "@"
     Let .Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
     Let .Value = Evaluate("=If({1},REPLACE(""0000000000"",11-LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))")
     Let .NumberFormat = "m/d/yyyy"
    End With
End Sub

or this , if you prefer

Code: Select all

Sub PrettyBeautiful()
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "@"
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=DAY(ROW(1:" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))" & "&" & """/""" & "&" & "MONTH(" & Range("A1").Value2 & ")" & "&""/""&" & "YEAR(" & Range("A1").Value2 & ")")
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").Value = Evaluate("=If({1},REPLACE(""0000000000"",11-LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),LEN(F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "),F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "))")
 Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "m/d/yyyy"
End Sub

I should just say that the last date format , "m/d/yyyy" , I got from the macro recorder, it is like in Hans code, it is what the recorder gives me when I select Short date format, ( https://i.postimg.cc/5trDr4BY/Short-Date-Format.jpg ).

Code: Select all

Sub Macro4() ' Got from macro recorder
'
' Macro4 Macro
'
    Range("F1:F30").Select
    Selection.NumberFormat = "m/d/yyyy" ' - got by selecting  Short Date  when running macro recorder    https://i.postimg.cc/5trDr4BY/Short-Date-Format.jpg
End Sub

- I am slightly confused that I don't have "d/m/yyyy" or "dd/mm/yyyy"
If I change to Let Range("F1:F" & Evaluate("=DAY(EOMONTH(" & Range("A1").Value2 & ",0))") & "").NumberFormat = "dd/mm/yyyy" , then my Excel tells me that I have format TT-MM-JJJJ ( https://i.postimg.cc/GtTLfgTr/TT-MM-JJJJ.jpg )
So as ever, date formats are confusing

You may want to experiment with that last format code line a bit….