Paste one array (single dimension) with >100K item into a excel range - vba

Question

I posted the same question on StackOverflow thread
but I think here is the correct place to ask (if is not right, admin please to remove it).Every day I need to format date imported from AS400 (data, time,..).
Usualy (for some thousands of record) I use this code.
Public Sub Cfn_FormatDate(control As IRibbonControl)
Application.ScreenUpdating = False
Dim UR As Long, X As Long
Dim MyCol As Integer
MyCol = ActiveCell.Column
UR = Cells(Rows.Count, MyCol).End(xlUp).Row
For X = 2 To UR
If Not IsDate(Cells(X, MyCol)) Then
Select Case Len(Cells(X, MyCol))
Case 8
Cells(X, MyCol) = DateSerial(Left(Cells(X, MyCol), 4), Mid(Cells(X, MyCol), 5, 2), Right(Cells(X, MyCol), 2))
Case 6
Cells(X, MyCol) = DateSerial(Left(Cells(X, MyCol), 2), Mid(Cells(X, MyCol), 3, 2), Right(Cells(X, MyCol), 2))
End Select
End If
Next X
Columns(MyCol).NumberFormat = "DD/MM/YYYY;#"
Columns(MyCol).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
but if the records are are many more, the code posted code is not performing.
(ex 70K records were formatted / pasted in 18 seconds)
so I thought to using variables in an array and I wrote this code:
Sub ConvDate(c As Integer)
Application.ScreenUpdating = False
Dim lrw As Long, i As Long
Dim ArrVal As Variant
lrw = ActiveSheet().Range(Cells(1, c)).End(xlDown).Row
ReDim ArrVal(2 To lrw)
For i = 2 To lrw
If IsDate(Cells(i, c)) Then
ArrVal(i) = Cells(i, c)
Else
Select Case Len(Cells(i, c)) ' to check YYYYMMDD or YYMMDD
Case 8
ArrVal(i) = DateSerial(Left(Cells(i, c), 4), Mid(Cells(i, c), 5, 2), Right(Cells(i, c), 2))
Case 6
ArrVal(i) = DateSerial(Left(Cells(i, c), 2), Mid(Cells(i, c), 3, 2), Right(Cells(i, c), 2))
End Select
End If
NextX:
Next i
Range(Cells(2, c), Cells(lrw, c)) = ArrVal
Columns(c).NumberFormat = "DD/MM/YYYY;#"
Columns(c).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
It not work, all the cells (in the range) have the same result (Cells(2, c)).
a guy suggested me to change the code like:
ActiveSheet.Range(Cells(2, c), Cells(lrw, c)).Value = WorksheetFunction.Transpose(ArrVal)
this change is limiting , over 65536 records I get an error (runtime 13, type mismatch)

Answer 1

Ok, to summarise all the answers and comments:
As you have indicated in your question and as user85489 alludes, reading the values into an array, manipulating that same array, and writing it back to the sheet is vastly quicker than lopping cell by cell.
If you have an array whose 'row' dimension is not going to change. Then it might be fair to say that you're better off declaring a 2 dimensional array of size (1 to rows, 1 to columns). This way you can avoid having to transpose a 1 dimensional array at all.
Because as Gareth points out, Transpose() is limited to 65536 elements in a dimension.
Putting it all together, then, skeleton code for your post could be this:
Sub ConvertDates(colIndex As Long)
Dim v As Variant
Dim firstCell As Range
Dim lastCell As Range
Dim fullRange As Range
Dim i As Long
Dim dd As Integer
Dim mm As Integer
Dim yy As Integer
Dim dat As Date
'Define the range
With ThisWorkbook.Worksheets("Sheet1")
Set firstCell = .Cells(2, colIndex)
Set lastCell = .Cells(.Rows.Count, colIndex).End(xlUp)
Set fullRange = .Range(firstCell, lastCell)
End With
'Read the values into an array
v = fullRange.Value
'Convert the text values to dates
For i = 1 To UBound(v, 1)
If Not IsDate(v(i, 1)) Then
If Len(v(i, 1)) = 6 Then v(i, 1) = "20" & v(i, 1)
yy = CInt(Left(v(i, 1), 4))
mm = CInt(Mid(v(i, 1), 5, 2))
dd = CInt(Right(v(i, 1), 2))
dat = DateSerial(yy, mm, dd)
v(i, 1) = dat
End If
Next
'Write the revised array and format range
With fullRange
.NumberFormat = "DD/MM/YYYY;#"
.Value = v
.EntireColumn.AutoFit
End With
End Sub

Answer 2

You have come across the 32 bit limitation of the function Transpose which truncates your array to 65536.

Answer 3

You can use loop statement to populate the cells, else if you want to do it directly then define your array ArrVal like:
Redim ArrVal(1,Lrw) as variant
Flood the array with values and then, Offload it like
Range(Cells(2, c), Cells(lrw, c)) = ArrVal
Hopefully you get rid of the same value errors.