VBA Excel 2-Dimensional Arrays
In fact I would not use any REDIM, nor a loop for transferring data from sheet to array:
dim arOne()
arOne = range("A2:F1000")
or even
arOne = range("A2").CurrentRegion
and that's it, your array is filled much faster then with a loop, no redim.
Here's A generic VBA Array To Range function that writes an array to the sheet in a single 'hit' to the sheet. This is much faster than writing the data into the sheet one cell at a time in loops for the rows and columns... However, there's some housekeeping to do, as you must specify the size of the target range correctly.
This 'housekeeping' looks like a lot of work and it's probably rather slow: but this is 'last mile' code to write to the sheet, and everything is faster than writing to the worksheet. Or at least, so much faster that it's effectively instantaneous, compared with a read or write to the worksheet, even in VBA, and you should do everything you possibly can in code before you hit the sheet.
A major component of this is error-trapping that I used to see turning up everywhere . I hate repetitive coding: I've coded it all here, and - hopefully - you'll never have to write it again.
A VBA 'Array to Range' function
Public Sub ArrayToRange(rngTarget As Excel.Range, InputArray As Variant)
' Write an array to an Excel range in a single 'hit' to the sheet
' InputArray must be a 2-Dimensional structure of the form Variant(Rows, Columns)
' The target range is resized automatically to the dimensions of the array, with
' the top left cell used as the start point.
' This subroutine saves repetitive coding for a common VBA and Excel task.
' If you think you won't need the code that works around common errors (long strings
' and objects in the array, etc) then feel free to comment them out.
On Error Resume Next
'
' Author: Nigel Heffernan
' HTTP://Excellerando.blogspot.com
'
' This code is in te public domain: take care to mark it clearly, and segregate
' it from proprietary code if you intend to assert intellectual property rights
' or impose commercial confidentiality restrictions on that proprietary code
Dim rngOutput As Excel.Range
Dim iRowCount As Long
Dim iColCount As Long
Dim iRow As Long
Dim iCol As Long
Dim arrTemp As Variant
Dim iDimensions As Integer
Dim iRowOffset As Long
Dim iColOffset As Long
Dim iStart As Long
Application.EnableEvents = False
If rngTarget.Cells.Count > 1 Then
rngTarget.ClearContents
End If
Application.EnableEvents = True
If IsEmpty(InputArray) Then
Exit Sub
End If
If TypeName(InputArray) = "Range" Then
InputArray = InputArray.Value
End If
' Is it actually an array? IsArray is sadly broken so...
If Not InStr(TypeName(InputArray), "(") Then
rngTarget.Cells(1, 1).Value2 = InputArray
Exit Sub
End If
iDimensions = ArrayDimensions(InputArray)
If iDimensions < 1 Then
rngTarget.Value = CStr(InputArray)
ElseIf iDimensions = 1 Then
iRowCount = UBound(InputArray) - LBound(InputArray)
iStart = LBound(InputArray)
iColCount = 1
If iRowCount > (655354 - rngTarget.Row) Then
iRowCount = 655354 + iStart - rngTarget.Row
ReDim Preserve InputArray(iStart To iRowCount)
End If
iRowCount = UBound(InputArray) - LBound(InputArray)
iColCount = 1
' It's a vector. Yes, I asked for a 2-Dimensional array. But I'm feeling generous.
' By convention, a vector is presented in Excel as an arry of 1 to n rows and 1 column.
ReDim arrTemp(LBound(InputArray, 1) To UBound(InputArray, 1), 1 To 1)
For iRow = LBound(InputArray, 1) To UBound(InputArray, 1)
arrTemp(iRow, 1) = InputArray(iRow)
Next
With rngTarget.Worksheet
Set rngOutput = .Range(rngTarget.Cells(1, 1), rngTarget.Cells(iRowCount + 1, iColCount))
rngOutput.Value2 = arrTemp
Set rngTarget = rngOutput
End With
Erase arrTemp
ElseIf iDimensions = 2 Then
iRowCount = UBound(InputArray, 1) - LBound(InputArray, 1)
iColCount = UBound(InputArray, 2) - LBound(InputArray, 2)
iStart = LBound(InputArray, 1)
If iRowCount > (65534 - rngTarget.Row) Then
iRowCount = 65534 - rngTarget.Row
InputArray = ArrayTranspose(InputArray)
ReDim Preserve InputArray(LBound(InputArray, 1) To UBound(InputArray, 1), iStart To iRowCount)
InputArray = ArrayTranspose(InputArray)
End If
iStart = LBound(InputArray, 2)
If iColCount > (254 - rngTarget.Column) Then
ReDim Preserve InputArray(LBound(InputArray, 1) To UBound(InputArray, 1), iStart To iColCount)
End If
With rngTarget.Worksheet
Set rngOutput = .Range(rngTarget.Cells(1, 1), rngTarget.Cells(iRowCount + 1, iColCount + 1))
Err.Clear
Application.EnableEvents = False
rngOutput.Value2 = InputArray
Application.EnableEvents = True
If Err.Number <> 0 Then
For iRow = LBound(InputArray, 1) To UBound(InputArray, 1)
For iCol = LBound(InputArray, 2) To UBound(InputArray, 2)
If IsNumeric(InputArray(iRow, iCol)) Then
' no action
Else
InputArray(iRow, iCol) = "" & InputArray(iRow, iCol)
InputArray(iRow, iCol) = Trim(InputArray(iRow, iCol))
End If
Next iCol
Next iRow
Err.Clear
rngOutput.Formula = InputArray
End If 'err<>0
If Err <> 0 Then
For iRow = LBound(InputArray, 1) To UBound(InputArray, 1)
For iCol = LBound(InputArray, 2) To UBound(InputArray, 2)
If IsNumeric(InputArray(iRow, iCol)) Then
' no action
Else
If Left(InputArray(iRow, iCol), 1) = "=" Then
InputArray(iRow, iCol) = "'" & InputArray(iRow, iCol)
End If
If Left(InputArray(iRow, iCol), 1) = "+" Then
InputArray(iRow, iCol) = "'" & InputArray(iRow, iCol)
End If
If Left(InputArray(iRow, iCol), 1) = "*" Then
InputArray(iRow, iCol) = "'" & InputArray(iRow, iCol)
End If
End If
Next iCol
Next iRow
Err.Clear
rngOutput.Value2 = InputArray
End If 'err<>0
If Err <> 0 Then
For iRow = LBound(InputArray, 1) To UBound(InputArray, 1)
For iCol = LBound(InputArray, 2) To UBound(InputArray, 2)
If IsObject(InputArray(iRow, iCol)) Then
InputArray(iRow, iCol) = "[OBJECT] " & TypeName(InputArray(iRow, iCol))
ElseIf IsArray(InputArray(iRow, iCol)) Then
InputArray(iRow, iCol) = Split(InputArray(iRow, iCol), ",")
ElseIf IsNumeric(InputArray(iRow, iCol)) Then
' no action
Else
InputArray(iRow, iCol) = "" & InputArray(iRow, iCol)
If Len(InputArray(iRow, iCol)) > 255 Then
' Block-write operations fail on strings exceeding 255 chars. You *have*
' to go back and check, and write this masterpiece one cell at a time...
InputArray(iRow, iCol) = Left(Trim(InputArray(iRow, iCol)), 255)
End If
End If
Next iCol
Next iRow
Err.Clear
rngOutput.Text = InputArray
End If 'err<>0
If Err <> 0 Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
iRowOffset = LBound(InputArray, 1) - 1
iColOffset = LBound(InputArray, 2) - 1
For iRow = 1 To iRowCount
If iRow Mod 100 = 0 Then
Application.StatusBar = "Filling range... " & CInt(100# * iRow / iRowCount) & "%"
End If
For iCol = 1 To iColCount
rngOutput.Cells(iRow, iCol) = InputArray(iRow + iRowOffset, iCol + iColOffset)
Next iCol
Next iRow
Application.StatusBar = False
Application.ScreenUpdating = True
End If 'err<>0
Set rngTarget = rngOutput ' resizes the range This is useful, *most* of the time
End With
End If
End Sub
You will need the source for ArrayDimensions:
This API declaration is required in the module header:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
...And here's the function itself:
Private Function ArrayDimensions(arr As Variant) As Integer
'-----------------------------------------------------------------
' will return:
' -1 if not an array
' 0 if an un-dimmed array
' 1 or more indicating the number of dimensions of a dimmed array
'-----------------------------------------------------------------
' Retrieved from Chris Rae's VBA Code Archive - http://chrisrae.com/vba
' Code written by Chris Rae, 25/5/00
' Originally published by R. B. Smissaert.
' Additional credits to Bob Phillips, Rick Rothstein, and Thomas Eyde on VB2TheMax
Dim ptr As Long
Dim vType As Integer
Const VT_BYREF = &H4000&
'get the real VarType of the argument
'this is similar to VarType(), but returns also the VT_BYREF bit
CopyMemory vType, arr, 2
'exit if not an array
If (vType And vbArray) = 0 Then
ArrayDimensions = -1
Exit Function
End If
'get the address of the SAFEARRAY descriptor
'this is stored in the second half of the
'Variant parameter that has received the array
CopyMemory ptr, ByVal VarPtr(arr) + 8, 4
'see whether the routine was passed a Variant
'that contains an array, rather than directly an array
'in the former case ptr already points to the SA structure.
'Thanks to Monte Hansen for this fix
If (vType And VT_BYREF) Then
' ptr is a pointer to a pointer
CopyMemory ptr, ByVal ptr, 4
End If
'get the address of the SAFEARRAY structure
'this is stored in the descriptor
'get the first word of the SAFEARRAY structure
'which holds the number of dimensions
'...but first check that saAddr is non-zero, otherwise
'this routine bombs when the array is uninitialized
If ptr Then
CopyMemory ArrayDimensions, ByVal ptr, 2
End If
End Function
Also: I would advise you to keep that declaration private. If you must make it a public Sub in another module, insert the Option Private Module statement in the module header. You really don't want your users calling any function with CopyMemoryoperations and pointer arithmetic.
For this example you will need to create your own type, that would be an array. Then you create a bigger array which elements are of type you have just created.
To run my example you will need to fill columns A and B in Sheet1 with some values. Then run test(). It will read first two rows and add the values to the BigArr. Then it will check how many rows of data you have and read them all, from the place it has stopped reading, i.e., 3rd row.
Tested in Excel 2007.
Option Explicit
Private Type SmallArr
Elt() As Variant
End Type
Sub test()
Dim x As Long, max_row As Long, y As Long
'' Define big array as an array of small arrays
Dim BigArr() As SmallArr
y = 2
ReDim Preserve BigArr(0 To y)
For x = 0 To y
ReDim Preserve BigArr(x).Elt(0 To 1)
'' Take some test values
BigArr(x).Elt(0) = Cells(x + 1, 1).Value
BigArr(x).Elt(1) = Cells(x + 1, 2).Value
Next x
'' Write what has been read
Debug.Print "BigArr size = " & UBound(BigArr) + 1
For x = 0 To UBound(BigArr)
Debug.Print BigArr(x).Elt(0) & " | " & BigArr(x).Elt(1)
Next x
'' Get the number of the last not empty row
max_row = Range("A" & Rows.Count).End(xlUp).Row
'' Change the size of the big array
ReDim Preserve BigArr(0 To max_row)
Debug.Print "new size of BigArr with old data = " & UBound(BigArr)
'' Check haven't we lost any data
For x = 0 To y
Debug.Print BigArr(x).Elt(0) & " | " & BigArr(x).Elt(1)
Next x
For x = y To max_row
'' We have to change the size of each Elt,
'' because there are some new for,
'' which the size has not been set, yet.
ReDim Preserve BigArr(x).Elt(0 To 1)
'' Take some test values
BigArr(x).Elt(0) = Cells(x + 1, 1).Value
BigArr(x).Elt(1) = Cells(x + 1, 2).Value
Next x
'' Check what we have read
Debug.Print "BigArr size = " & UBound(BigArr) + 1
For x = 0 To UBound(BigArr)
Debug.Print BigArr(x).Elt(0) & " | " & BigArr(x).Elt(1)
Next x
End Sub
You need ReDim:
m = 5
n = 8
Dim my_array()
ReDim my_array(1 To m, 1 To n)
For i = 1 To m
For j = 1 To n
my_array(i, j) = i * j
Next
Next
For i = 1 To m
For j = 1 To n
Cells(i, j) = my_array(i, j)
Next
Next
As others have pointed out, your actual problem would be better solved with ranges. You could try something like this:
Dim r1 As Range
Dim r2 As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
totalRow = ws1.Range("A1").End(xlDown).Row
totalCol = ws1.Range("A1").End(xlToRight).Column
Set r1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(totalRow, totalCol))
Set r2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(totalRow, totalCol))
r2.Value = r1.Value