Sub WriteReadRange()
Dim MyArray()
Dim Time1 As Date
Range("A:A").ClearContents
NumElements = 1000
If NumElements = "" Then Exit Sub
ReDim MyArray(1 To NumElements)
For i = 1 To NumElements
MyArray(i) = i
Next i
Application.ScreenUpdating = False
Time1 = Timer
For i = 1 To NumElements
Cells(i, 1) = i
Next i
WriteTime = Format(Timer - Time1, "00:00")
Time1 = Timer
For i = 1 To NumElements
MyArray(i) = Cells(i, 1)
Next i
ReadTime = Format(Timer - Time1, "00:00")
Application.ScreenUpdating = True
Debug.Print "Write: " & WriteTime
Debug.Print "Read: " & ReadTime
End Sub