Printing values from a multidimensional array - excel

Question

I have a block of data which I define as a range ("ARRAY_DIM") in excel. The range includes a lot of data but also have many rows and columns with no data at all. Below is an example of the defined range. Please note that the number of data columns for each identifier varies which is why the ARRAY_DIM is defined with +100 columns (of which only few rows will contain data).
Banana 10 20 30 40 50 70
Parrot 5 1 4 30
Apple 3 3 5 6 20
Car 10 20 30 40 30
Donkey 4 12 3 0 4 5
Coconut 10 4 0 1
I am inserting all of this data into an array such that I can loop through a list of relevant identifiers and then paste the data associated with the identifiers in the adjacent cells (same row). See below for a simplified example of identifiers (first column is a range defined as "OUTPUT") and where I intend to paste the relevant data for identifiers that are included in the array.
Banana 10 20 30 40 50 70
SHARK
Apple 3 3 5 6 20
Airplane
I am having troubles with accomplishing this task based on the code below. It works fine for the first row/identifier but then I get an error "Subscript out of range" at the .Cells output line. I would appreciate if someone can review the code and maybe point out any errors.
Sub test()
Dim arr As Variant
Dim cell As Range
With ThisWorkbook.Sheets("Sheet1")
arr = .Range("ARRAY_DIM")
End With
With ThisWorkbook.Sheets("Sheet2")
For Each cell In .Range("OUTPUT")
For x = LBound(arr, 1) To UBound(arr, 1)
If arr(x, 1) = cell.Value Then
For n = LBound(arr, 1) To UBound(arr, 1)
.Cells(cell.Row, n + 2) = arr(x, n + 1)
Next n
End If
Next x
Next cell
End With
End Sub

Answer 1

This should handle it, assuming unique labels in the first columns:
Dim data As Object
Dim r As Range
Dim thisName As String
Dim thisData As Range
Set data = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Sheet1")
' Store each row in our Dictionary with key=item name, value=row values
For Each r In .Range("ARRAY_DIM").Rows
Set data(r.Cells(1).Value) = r.Resize(1, r.Columns.Count - 1).Offset(0, 1)
Next
End With
With ThisWorkbook.Sheets("Sheet2")
For Each r In .Range("OUTPUT").Columns(1).Cells
thisName = r.Cells(1).Value
' Check if thisName exists in our Dictionary
If data.Exists(thisName) Then
' Dump the data into the row if it exists
Set thisData = data(thisName)
r.Offset(0, 1).Resize(1, thisData.Columns.Count).Value = thisData.Value
End If
Next
End With
But I think that can be further simplified to a single loop:
Dim r As Range
Dim thisName As String
Dim thisData As Range
Dim outputRow As Variant
Dim outputRange as Range
Set outputRange = ThisWorkbook.Sheets("Sheet2").Range("OUTPUT")
With ThisWorkbook.Sheets("Sheet1").Range("ARRAY_DIM")
For Each r In .Rows
thisName = r.Cells(1).Value
' Check whether thisName exists in outputRange
outputRow = Application.Match(thisName, outputRange, False)
If Not IsError(outputRow) Then
' Dump this row's Values to the outputRange
outputRange.Rows(outputRow).Value = r.Value
End If
Next
End With
NB: Neither of the above approaches will add a new row if the thisName isn't found in the OUTPUT range.