VBA Excel 2-Dimensional Arrays

Question

I was trying to find out how to declare a 2-Dimensional array but all of the examples I have found so far are declared with set integers   I m trying to create a program that will utilize two 2-Dimensional arrays and then perform simple operations on those arrays  such as finding difference or percent    The arrays are populated by numbers in Excel sheets  one set of numbers is on Sheet1 and another set is on Sheet2  both sets have the same number of rows and columns    Since I don t know how many rows or columns there are I was going to use variables   Dim s1excel As Worksheet Dim s2excel As Worksheet Dim s3excel As Worksheet Dim firstSheetName As String Dim secondSheetName As String Dim totalRow As Integer Dim totalCol As Integer Dim iRow As Integer Dim iCol As Integer  Set s1excel   ThisWorkbook ActiveSheet    Open the  Raw Data  workbook Set wbs   Workbooks Open file path  amp  data title  wbs Activate ActiveWorkbook Sheets firstSheetName  Select Set s2excel   wbs ActiveSheet    Find totalRow  totalColumn  assumes there s values in Column A and Row 1 with no blanks  totalRow   ActiveSheet Range  A1   End xlDown  Row totalCol   ActiveSheet Range  A1   End xlToRight  Column  Dim s2Array totalRow  totalCol  Dim s3Array totalRow  totalCol   For iRow   1 To totalRow     For iCol   1 To totalCol         s2Array iRow  iCol    Cells iRow  iCol      Next iCol Next iRow  ActiveWorkbook Sheets secondSheetName  Select Set s3excel   wbs ActiveSheet  For iRow   1 To totalRow     For iCol   1 To totalCol         s3Array iRow  iCol    Cells iRow  iCol      Next iCol Next iRow   When I attempt to run this I get a compile-time error at the Dim s2Array totalRow  totalCol  saying that a constant expression is required  The same error occurs if I change it to Dim s2Array 1 To totalRow  1 To totalCol    Since I don t know what the dimensions are from the get go I can t declare it like Dim s2Array 1  1  because then I ll get an out-of-bounds exception   Thank you   Jesse Smothermon

User · Answer

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

User · Answer

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  gt  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  lt  1 Then      rngTarget Value   CStr InputArray   ElseIf iDimensions   1 Then      iRowCount   UBound InputArray  - LBound InputArray      iStart   LBound InputArray      iColCount   1      If iRowCount  gt   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  gt   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  gt   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  lt  gt  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        amp  InputArray iRow  iCol                          InputArray iRow  iCol    Trim InputArray iRow  iCol                       End If                 Next iCol             Next iRow             Err Clear             rngOutput Formula   InputArray         End If  err lt  gt 0          If Err  lt  gt  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         amp  InputArray iRow  iCol                          End If                         If Left InputArray iRow  iCol   1        Then                             InputArray iRow  iCol         amp  InputArray iRow  iCol                          End If                         If Left InputArray iRow  iCol   1        Then                             InputArray iRow  iCol         amp  InputArray iRow  iCol                          End If                     End If                 Next iCol             Next iRow             Err Clear             rngOutput Value2   InputArray         End If  err lt  gt 0          If Err  lt  gt  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     amp  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        amp  InputArray iRow  iCol                          If Len InputArray iRow  iCol    gt  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 lt  gt 0          If Err  lt  gt  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       amp  CInt 100    iRow   iRowCount   amp                      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 lt  gt 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    amp H4000 amp      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

User · Answer

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

User · Answer

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

[excel] VBA Excel 2-Dimensional Arrays

Examples related to excel

Examples related to vba

Examples related to multidimensional-array