Visit my Youtube Channel
Introduction to Dynamic Arrays
Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.
In this session, we are going to cover Dynamic Arrays in VBA which are a powerful tool that is guaranteed to take your programming skills to the next level. There is a bit of a learning curve here. But, the payoff is definitely worth it. In my experience, if you know Dynamic Arrays and Dictionaries, you can manipulate any dataset any which way you want to.
We will be using the below datasets.
Load/ Offload Dynamic Arrays
Sub BasicDynamicArrays()
wsOut.Cells.Clear
Dim lrow As Long
lrow = wsIn.Range("a1").CurrentRegion.Rows.Count
Dim arr() As Variant
arr = wsIn.Range("A1:F" & lrow).Value
'arr = wsIn.Range("A1").CurrentRegion.Value
'Copy Data Using Dynamic Arrays
'wsOut.Range("A1:F" & lrow).Value = arr
wsOut.Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
'Lbound(arr,1) and Ubound(arr,1)
'Lbound(arr,2) and Ubound(arr,2)
End Sub
Manipulate Data
Sub ManipulateDataUsingDynamicArrays()
wsOut.Cells.Clear
Dim arr() As Variant
arr = wsIn.Range("A1").CurrentRegion.Value
Dim i As Long
For i = LBound(arr, 1) To UBound(arr, 1)
If i = 1 Then GoTo NextIteration
arr(i, 2) = "INV-" & arr(i, 2)
NextIteration:
Next i
wsOut.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
Exclude Headers when Loading
Sub ManipulateDataUsingDynamicArrays_IgnoreHeaders()
wsOut.Rows("2:" & Rows.Count).ClearContents
Dim lrow As Long
lrow = wsIn.Range("A1").CurrentRegion.Rows.Count
Dim arr() As Variant
arr = wsIn.Range("A2:F" & lrow).Value
Dim i As Long
For i = LBound(arr, 1) To UBound(arr, 1)
arr(i, 2) = "INV-" & arr(i, 2)
Next i
wsOut.Range("A2:F" & lrow).Value = arr
End Sub
Resize Dynamic Array
Sub ResizeDynamicArrays()
wsOut.Cells.Clear
Dim lcol As Long
lcol = wsIn.Range("A1").CurrentRegion.Columns.Count
Dim arrInHeader() As Variant
arrInHeader = wsIn.Range(wsIn.Cells(1, 1), wsIn.Cells(1, lcol)).Value
Dim newCol As Long
newCol = UBound(arrInHeader, 2) + 1
ReDim Preserve arrInHeader(1 To 1, 1 To newCol)
arrInHeader(1, newCol) = "Region"
wsOut.Range("A1").Resize(UBound(arrInHeader, 1), UBound(arrInHeader, 2)).Value = arrInHeader
End Sub
Perform a Lookup
Sub LookupUsingDynamicArrays()
'Populate Headers
ResizeDynamicArrays
Dim lrow As Long
lrow = wsIn.Range("A1").CurrentRegion.Rows.Count
Dim arr() As Variant
arr = wsIn.Range("A2:G" & lrow).Value
lrow = wsMap.Range("A1").CurrentRegion.Rows.Count
Dim arrMap() As Variant
arrMap = wsMap.Range("A2:B" & lrow).Value
Dim i As Long, k As Long
Dim inStoreName As String, mapStoreName As String
For i = LBound(arr, 1) To UBound(arr, 1)
inStoreName = arr(i, 3)
For k = LBound(arrMap, 1) To UBound(arrMap, 1)
mapStoreName = arrMap(k, 1)
If inStoreName = mapStoreName Then
arr(i, UBound(arr, 2)) = arrMap(k, 2)
Exit For
End If
Next k
Next i
wsOut.Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
Create a 2nd Dynamic Array
Sub ReziseAsYouLoop()
wsOut.Rows("2:" & Rows.Count).ClearContents
Dim lrow As Long
lrow = wsIn.Range("A1").CurrentRegion.Rows.Count
Dim arrIn() As Variant
arrIn = wsIn.Range("A2:F" & lrow).Value
Dim arrOut() As Variant
ReDim arrOut(1 To UBound(arrIn, 2), 1 To 1)
Dim i As Long, k As Long
Dim arrCount As Long
arrCount = 0
For i = LBound(arrIn, 1) To UBound(arrIn, 1)
If arrIn(i, 3) = "Hi-Fi Manly Park" Then
arrCount = arrCount + 1
ReDim Preserve arrOut(1 To UBound(arrIn, 2), 1 To arrCount)
For k = 1 To UBound(arrIn, 2)
arrOut(k, arrCount) = arrIn(i, k)
Next k
End If
Next i
wsOut.Range("A2").Resize(UBound(arrOut, 2), UBound(arrOut, 1)).Value = _
Application.WorksheetFunction.Transpose(arrOut)
End Sub