Home » excel » excel – Printing values from a multidimensional array

excel – Printing values from a multidimensional array

Posted by: admin May 14, 2020 Leave a comment

Questions:

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
How to&Answers:

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.