michaelsmith559
Well-known Member
- Joined
- Oct 6, 2013
- Messages
- 881
- Office Version
- 2013
- 2007
Code:
Sub ArrayFillRange()
' Fill a range by transferring an array
Dim CellsDown As Long, CellsAcross As Long
Dim i As Long, j As Long
Dim StartTime As Double
Dim TempArray() As Double
Dim TheRange As Range
Dim CurrVal As Double
' Change these values
CellsDown = 1048576
CellsAcross = 16384
Cells.Clear
' Record starting time
StartTime = Timer
' Redimension temporary array
ReDim TempArray(1 To CellsDown, 1 To CellsAcross)
' Set worksheet range
Set TheRange = Range(Cells(1, 1), Cells(CellsDown, CellsAcross))
' Fill the temporary array
CurrVal = 4.41028223935346E-02
Application.EnableEvents = False
Application.ScreenUpdating = False
For i = 1 To CellsDown
For j = 1 To CellsAcross
TempArray(i, j) = CurrVal
CurrVal = CurrVal + 1
If CurrVal = 4.47028223935344E-02 Then
Exit Sub
Else
End If
Next j
Next i
' Transfer temporary array to worksheet
TheRange.Value = TempArray
' Display elapsed time
dApplication.ScreenUpdating = True
Application.EnableEvents = True
MsgBox Format(Timer - StartTime, "00.00") & " seconds"
End Sub