Clash Royale CLAN TAG#URR8PPP

Excel VBA printing a date array to sheet converts to American format

I have an array of dates in VBA. If I print it to the sheet one date at a time everything is perfect. However, when I print the entire array to a column in bulk, the date format changes from (dd/mm/yy) to (mm/dd/yy). So May 7th is converted to July 5th and May 25th is not really formatted as date on the sheet. Here is my code. It is independent and can be executed if copy pasted to any Excel.
(and another smaller problem I have: how can I get rid of the need to transpose when printing to a column. I have performance problems and trying to save as much time as possible. This piece of "pseudo code" is executed 30K times in the macro).
Thank you.

Public Sub test05()
Dim dt As Date, fromDate As Date, toDate As Date
Dim dayCounter As Integer
Dim sheet As Worksheet
Dim dtArr() As Date
Set sheet = Sheets("Sheet1")
fromDate = DateSerial(2018, 8, 6)
toDate = DateSerial(2023, 8, 5)
sheet.Cells.ClearContents
dayCounter = 0
For dt = fromDate To toDate
wd = Weekday(dt)
If wd = 1 Or wd = 7 Then
'skip weekends
GoTo NextDayIteration
End If
dayCounter = dayCounter + 1

ReDim Preserve dtArr(1 To dayCounter)

dtArr(dayCounter) = dt

'print the dates (one by one) to the sheet in column 1
sheet.Cells(dayCounter, 1).Value2 = dt
NextDayIteration:
Next 'end of each day

'print all the dates array to the sheet in bulk, in column 2
Dim rng As Range
With sheet
Set rng = .Range(.Cells(1, 2), .Cells(UBound(dtArr) - LBound(dtArr) + 1, 2))
End With

rng.Value2 = Application.Transpose(dtArr)

End Sub


rng.Numberformat = "dd/mm/yy"

rng.Value2 =...

1 Answer
1

Don't use Transpose or Preserve. You can do something like this instead:

Transpose

Preserve

Public Sub test05()
Dim dt As Date, fromDate As Date, toDate As Date
Dim dayCounter As Long
Dim sheet As Worksheet
Dim dtArr() As Date
Set sheet = Sheets("Sheet1")
fromDate = DateSerial(2018, 8, 6)
toDate = DateSerial(2023, 8, 5)
ReDim dtArr(1 To toDate - fromDate + 1, 1 To 1)
sheet.Cells.ClearContents
dayCounter = 0
For dt = fromDate To toDate
wd = Weekday(dt)
Select Case wd
Case 1, 7
'skip weekends
Case Else
dayCounter = dayCounter + 1

dtArr(dayCounter, 1) = dt

'print the dates (one by one) to the sheet in column 1
sheet.Cells(dayCounter, 1).Value2 = dt
End Select
Next 'end of each day

'print all the dates array to the sheet in bulk, in column 2
Dim rng As Range
With sheet
Set rng = .Range(.Cells(1, 2), .Cells(dayCounter, 2))
End With

rng.Value2 = dtArr

End Sub


dayCounter

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.