VBA/Excel/Access/Word/Data Type/Array

Arrays are typically initialized inside a loop

 
Sub arrayInit()
    Dim I As Integer
    Dim myArray(10) As Integer
    For I = 0 To 9
      myArray(I) = Cells(I + 1, "A").Value
    Next I
End Sub

Assign range to an array

 
Sub QuickFillMax()
    Dim myArray As Variant
    
    myArray = Worksheets("Sheet1").range("B2:C17")
    MsgBox "Maximum Integer is: " & WorksheetFunction.Max(myArray)
    
End Sub

Convert number to String by using Array

 

Function NumberToString(lngNumber As Long) As String
    Dim strNumber  As String    
    Dim intLoop    As Integer   
    Dim strRV      As String    
    Dim strTemp    As String    
    Dim astrNumbers As Variant  
    Dim iNumber     As Integer  
    astrNumbers = Array("Zero", "One", "Two", "Three", "Four", _
                      "Five", "Six", "Seven", "Eight", "Nine")
    strNumber = lngNumber
    For intLoop = 1 To Len(strNumber)
        iNumber = Int(Mid$(strNumber, intLoop, 1))
        strRV = strRV & astrNumbers(iNumber) & " "
    Next
    NumberToString = strRV
End Function

Declaring and Working with Fixed Arrays

 
Sub FixedArray()
    Dim astrNames(5) As String
    Dim intCounter As Integer
    astrNames(0) = "A"
    astrNames(1) = "B"
    astrNames(2) = "C"
    astrNames(3) = "Z"
    "Use a For...Next loop to loop through the elements of the array
    For intCounter = 0 To UBound(astrNames)
        Debug.Print astrNames(intCounter)
    Next intCounter
End Sub

Declaring array and setting bounds

 
Sub MyTestArray()
    Dim myArray(1 To 4) As String " Declaring array and setting bounds
    Dim Response As String
    Dim i As Integer
    Dim myFlag As Boolean
    myFlag = False
    myArray(1) = "A"
    myArray(2) = "B"
    myArray(3) = "C"
    myArray(4) = "D"
    Do Until myFlag = True
        Response = InputBox("Please enter your choice: (i.e. A,B,C or D)")
        For i = 1 To 4
            If UCase(Response) = UCase(myArray(i)) Then
                    myFlag = True: Exit For
            End If
        Next i
    Loop
End Sub

Declaring a static array is similar to declaring a variable

 
Sub arrayTest()
 Dim i As Integer
 Dim intMyScores(10) As Integer
 For i = 0 To 10
    intMyScores(i) = i
 Next
 For i = 0 To 10
    Debug.Print "For array element " & i & " the number is " & intMyScores(i)
 Next
End Sub

Declaring a static array is similar to declaring a variable, with one small exception

 
Sub arrayTest()
     Dim i As Integer
     Dim intMyScores(10) As Integer
    
     For i = 0 To 10
        intMyScores(i) = InputBox("Enter number " & i, "Static Array Test")
     Next
    
     For i = 0 To 10
        Debug.Print "For array element " & i & " the number is " & _
     intMyScores(i)
    Next
End Sub

Define and use multidimensional array

 
Sub MultiDimArray()
    Dim i As Integer
    Dim j As Integer
    Dim intNum() As Integer                   "Create a dynamic array
    ReDim intNum(2 To 3, 3 To 5)              "Resize the array
    For i = 2 To 3                            "Populate the array
        For j = 3 To 5
            intNum(i, j) = i ^ j
        Next j
    Next i
    For i = 2 To 3                            "Print the contents...
        For j = 3 To 5                        "...of the array
            Debug.Print i & "^" & j & "=" & intNum(i, j)
        Next j
    Next i
End Sub

Fill array by using a nested For- Next loop.

 
Sub NestedLoops()
    Dim MyArray(10, 10, 10)
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    For i = 1 To 10
        For j = 1 To 10
            For k = 1 To 10
                MyArray(i, j, k) = 0
            Next k
        Next j
    Next i
End Sub

Get the element in an array by index

 
Sub MonthNames()
    Dim varMonth As Variant
    
    varMonth = Array("Jan", "Feb", "Mar", "Apr")
    
    Debug.Print varMonth(1)
    Debug.Print varMonth(2)
    
End Sub

Override the Option Base setting by specifically setting the lower bound in the array declaration

 
Sub arrayDemo()
    Dim myArray(1 To 10) As Integer
End Sub

Referencing Elements in a Multi-dimensional Array

 
Sub MultiDimArray()
   Dim i As Integer
   Dim j As Integer
   Dim intNum() As Integer                   "Create a dynamic array
   ReDim intNum(2 To 3, 3 To 5)              "Resize the array
   For i = 2 To 3                            "Populate the array
      For j = 3 To 5
         intNum(i, j) = i ^ j
      Next j
   Next i
   For i = 2 To 3                            "Print the contents...
      For j = 3 To 5                        "...of the array
         Debug.Print i & "^" & j & "=" & intNum(i, j)
      Next j
   Next i
End Sub

Searching through an Array

 
  Option Base 1
  Sub Linear_Search_of_Array()
      Dim intArray(10) As Integer
      Dim i As Integer
      Dim varUserNumber As Variant

      For i = 1 To 10
          intArray(i) = Int(Rnd * 10)
          Debug.Print intArray(i)
      Next i
      varUserNumber = 4
      For i = 1 To UBound(intArray)
          If intArray(i) = varUserNumber Then
              Debug.Print "Your value, " & varUserNumber & ", was found at position " & i & " in the array."
              Exit For
          End If
      Next i
  End Sub

Sorting an Array

 
   Option Explicit
   Option Base 1
 
   Sub Sort_an_Array()
       Dim strArray(12) As String
       Dim strTemp As String
       Dim X As Integer, Y As Integer, i As Integer
      strArray(1) = "n"
      strArray(2) = "d"
      strArray(3) = "h"
      strArray(4) = "g"
      strArray(5) = "e"
      strArray(6) = "d"
      strArray(7) = "o"
      strArray(8) = "p"
      strArray(9) = "m"
      strArray(10) = "h"
      strArray(11) = "b"
      strArray(12) = "m"
      Debug.Print "Current items in array:"
      For i = 1 To UBound(strArray)
          Debug.Print strArray(i)
      Next i
      For X = LBound(strArray) To (UBound(strArray) - 1)
          For Y = (X + 1) To UBound(strArray)
              If strArray(X) > strArray(Y) Then
                  strTemp = strArray(X)
                  strArray(X) = strArray(Y)
                  strArray(Y) = strTemp
                  strTemp = ""
              End If
          Next Y
      Next X
      Debug.Print "Items in sorted array:"
      For i = 1 To UBound(strArray)
          Debug.Print strArray(i)
      Next i
  End Sub

Sorts the List array in ascending order

 
Sub BubbleSort(List())
    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If List(i) > List(j) Then
                Temp = List(j)
                List(j) = List(i)
                List(i) = Temp
            End If
        Next j
    Next i
End Sub

Specifying the Index Range of an Array

 
Sub ArrayExample() 
    Dim acWeeklySales(1 To 7) As Currency 
    Dim n As Integer 
    Dim sDay As String 
    acWeeklySales(1) = 55100.44 
    acWeeklySales(2) = 43666.43 
    acWeeklySales(3) = 67004.11 
    acWeeklySales(4) = 87121.29 
    acWeeklySales(5) = 76444.94 
    acWeeklySales(6) = 98443.84 
    acWeeklySales(7) = 87772.37 
    For n = 1 To 7 
        sDay = Choose(n, "Mon", "Tue", "Wed", "Thu","Fri", "Sat", "Sun") 
        Debug.Print"Sales for " & sDay & " were $" & acWeeklySales(n) 
    Next 
End Sub

To assume that 1 is the lower index for your arrays

 
Option Base 1

Understanding Errors in Arrays

 
Sub Zoo1()
    Dim zoo(3) As String
    Dim i As Integer
    Dim response As String
    zoo(5) = ""
End Sub

Use count function to count array

 
Sub Array3()
  Dim Data(10) As Integer
  Dim Message As String, i As Integer
  For i = LBound(Data) To UBound(Data)
    Data(i) = i
  Next i
  MsgBox "Num Elements = " & WorksheetFunction.Count(Data)
End Sub

Use count function to sum array

 
Sub Array4()
  Dim Data(10) As Integer
  Dim Message As String, i As Integer
  For i = LBound(Data) To UBound(Data)
    Data(i) = i
  Next i
  MsgBox "Sum Elements = " & WorksheetFunction.Sum(Data)
End Sub

Use LBound and UBound in for statement

 
Sub arrayTest2()
    Dim i As Integer
    Dim intMyScores(10) As Integer
    
    For i = LBound(intMyScores) To UBound(intMyScores)
        intMyScores(i) = i
    Next
    
     For i = 0 To 10
        Debug.Print "For array element " & i & " the number is " & intMyScores(i)
    Next
End Sub

Use the For Each...Next to assign value to an array

 
Sub ArrayWith()
    Dim astrNames(5) As String
    Dim intCounter As Integer
    Dim vntAny As Variant
    astrNames(0) = "A"
    astrNames(1) = "B"
    astrNames(2) = "C"
    astrNames(3) = "D"
    For Each vntAny In astrNames
        Debug.Print vntAny
    Next vntAny
End Sub

Using a One-Dimensional Array

 
"Option Base 1
Sub FavoriteCities()
    Dim cities(6) As String
    cities(1) = "Baltimore"
    cities(2) = "Atlanta"
    cities(3) = "Boston"
    cities(4) = "Washington"
    cities(5) = "New York"
    cities(6) = "Trenton"
    MsgBox cities(1) & Chr(13) & cities(2) & Chr(13) _
        & cities(3) & Chr(13) & cities(4) & Chr(13) _
        & cities(5) & Chr(13) & cities(6)
End Sub

Using Arrays and Loops

 
"Option Base 1
Sub FavoriteCities2()
    " declare the array
    Dim cities(6) As String
    Dim city As Variant
    " assign the values to array elements
    cities(1) = "Baltimore"
    cities(2) = "Atlanta"
    cities(3) = "Boston"
    cities(4) = "Washington"
    cities(5) = "New York"
    cities(6) = "Trenton"
    " display the list of cities in separate messages
    For Each city In cities
        MsgBox city
    Next
End Sub

Using a Two-Dimensional Array

 
Sub Exchange()
    Dim t As String
    Dim r As String
    Dim Ex(3, 3) As Variant
    t = Chr(9)  " Tab
    r = Chr(13) " Enter
    Ex(1, 1) = "Japan"
    Ex(1, 2) = "Japanese Yen"
    Ex(1, 3) = 102.76
    Ex(2, 1) = "Europe"
    Ex(2, 2) = "Euro"
    Ex(2, 3) = 0.744734
    Ex(3, 1) = "Canada"
    Ex(3, 2) = "Canadian Dollar"
    Ex(3, 3) = 1.20892
    MsgBox "Country " & t & t & "Currency" & t & t & "Value per US$" _
        & r & r & Ex(1, 1) & t & t & Ex(1, 2) & t & Ex(1, 3) & r _
        & Ex(2, 1) & t & t & Ex(2, 2) & t & t & Ex(2, 3) & r _
        & Ex(3, 1) & t & t & Ex(3, 2) & t & Ex(3, 3), , _
        "Exchange"
End Sub

Working with Parameter Arrays

 
Function AddMultipleArgs(ParamArray myNumbers() As Variant)
    Dim mySum As Single
    Dim myValue As Variant
    For Each myValue In myNumbers
        mySum = mySum + myValue
    Next
    AddMultipleArgs = mySum
End Function
Sub arrayPara()
  MsgBox AddMultipleArgs(1, 2, 3)
End Sub