VBA/Excel/Access/Word/Date Functions/Dynamic Array

A destroying the old values by using the Preserve keyword

 
Sub redimDemo()
    Dim MyArray() As Integer
    ReDim MyArray(12)
    ReDim Preserve MyArray(12)
End Sub

Declaring and Working with Dynamic Arrays

 
Sub DynamicArray()
    Dim astrNames() As String
    Dim intCounter As Integer
    Dim vntAny As Variant
    "Resize the array to hold two elements
    ReDim astrNames(1)
    astrNames(0) = "A"
    astrNames(1) = "B"
    "Use a For...Each loop to loop through the
    "elements of the array
    For Each vntAny In astrNames
        Debug.Print vntAny
    Next vntAny
End Sub

Dynamic Arrays

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

There"s a potential problem when you try to resize the array:

 
Sub ResizeDynamic()
    Dim astrNames() As String
    Dim intCounter As Integer
    Dim vntAny As Variant
    "Resize the array to hold two elements
    ReDim astrNames(1)
    astrNames(0) = "A"
    astrNames(1) = "B"
    "Resize the array to hold four elements
    ReDim astrNames(3)
    "Populate the last two elements
    astrNames(2) = "C"
    astrNames(3) = "D"
    For Each vntAny In astrNames
        Debug.Print vntAny
    Next vntAny
End Sub

Transpose() sub procedure is using a dynamic array that is re-dimensioned with two dimensions.

 
Public Sub DynamicTranspose()
    Dim I As Integer
    Dim J As Integer
    Dim transArray() As Integer
    Dim numRows As Integer
    Dim numColumns As Integer
    Do
        numRows = I
        I = I + 1
    Loop Until Cells(I, "A").Value = ""
    I = 0
    Do
        numColumns = I
        I = I + 1
    Loop Until Cells(1, Chr(I + 64)).Value = ""
    ReDim transArray(numRows - 1, numColumns - 1)
    "
    For I = 1 To numColumns
        For J = 1 To numRows
            transArray(J - 1, I - 1) = Cells(J, Chr(I + 64)).Value
        Next J
    Next I
    "
    Range("A1:C10").ClearContents
    "
    For I = 1 To numColumns
        For J = 1 To numRows
            Cells(I, Chr(J + 64)).Value = transArray(J - 1, I - 1)
        Next J
    Next I
End Sub

Use ReDim to create dynamic array

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

Use the Preserve keyword to keep the values

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

Using a Dynamic Array

 
Sub DynArray()
    Dim counter As Integer
    Dim myArray() As Integer
    ReDim myArray(5)
    Dim myValues As String
    For counter = 1 To 5
        myArray(counter) = counter + 1
        myValues = myValues & myArray(counter) & Chr(13)
    Next
    ReDim Preserve myArray(10)
    For counter = 6 To 10
        myArray(counter) = counter * 8
        myValues = myValues & myArray(counter) & Chr(13)
    Next counter
    Debug.Print myValues
    For counter = 1 To 10
        Debug.Print myArray(counter)
    Next counter
End Sub