如何将数组返回到Excel VBA范围

Question

I have been trying to get data from a worksheet and put it into array and then paste the array to other worksheet. However, after the loop my array return Empty . Do I need to return something from the For Loop? I searched didn't find any idea.

Sub generate()
    Dim article_arr() As Variant
    Dim artCount As Integer
    Dim filter As Integer
    Dim RIL_itemCount As Integer

    'Set PA number
    filter = Sheet7.Range("B1").Value
    RIL_itemCount = Sheet5.Cells(Sheet5.Rows.count, "A").End(xlUp).Row

    'Count number article of PA selected
    artCount = Application.WorksheetFunction.CountIf(Sheet5.Range("R:R"), filter)

    'redim array
    ReDim article_arr(0 To artCount)
    Dim j As Integer
    j = 0

    'populate array with article number from Retail Item List
    For i = 0 To RIL_itemCount
        If (Sheet5.Cells(i + 2, 18).Value = filter) Then
            article_arr(j) = Sheet5.Cells(i + 2, 1).Value          
            Debug.Print (article_arr(j))
        End If
    Next

    'Paste Article number to range
    Sheet7.Range("A8:A" & artCount) = articleArr()


End Sub

As mentioned by David G. I forgot to increment the J. I also use the wrong variable (newbie mistake) when pasting the Array. It now return result but it only return the first value of the array repeated over the pasted range. Do I need for loop to paste Array to range?

Apparently array will be pasted horizontally in the excel, which cause repetition of the first value when pasting the array to range. Adding WorksheetFunction.Transpose(array) do the magic

Here is the updated code:

Sub generate()
    Dim article_arr() As Variant
    Dim artCount As Integer
    Dim filter As Integer
    Dim RIL_itemCount As Integer

    'Set PA number
    filter = Sheet7.Range("B1").Value
    RIL_itemCount = Sheet5.Cells(Sheet5.Rows.count, "A").End(xlUp).Row

    'Count number article of PA selected
    artCount = Application.WorksheetFunction.CountIf(Sheet5.Range("R:R"), filter)

    'redim array
    ReDim article_arr(0 To artCount)
    Dim j As Integer
    j = 0

    'populate array with article number from Retail Item List
    For i = 0 To RIL_itemCount
        If (Sheet5.Cells(i + 2, 18).Value = filter) Then
            article_arr(j) = Sheet5.Cells(i + 2, 1).Value
            j = j + 1
        End If
    Next

    'Paste Article number to range
    k = 8
    Sheet7.Range("A" & k & ":A" & UBound(article_arr) + 7) = WorksheetFunction.Transpose(article_arr)
    Debug.Print (article_arr(395))


End Sub

Answer 1

Your array is supposed to be filled according to the j integer but you don't increment it.

For i = 0 To RIL_itemCount
    If (Sheet5.Cells(i + 2, 18).Value = filter) Then
        article_arr(j) = Sheet5.Cells(i + 2, 1).Value
        j = j + 1
        Debug.Print (article_arr(j))
    End If
Next

Also when pasting an array to a single cell, it will do exactly what you're describing; paste the first array value everywhere for the size of the array. To have it put the correct values, you need to send it to a range of the same size as the array. For example, for an array of size 2 by 3, you would write

Range("A1:B3") = array

In your case you would want the size to be dynamic, just like the size of your array.

k = 8
Range("A" & k & ":A" & k + Ubound(article_arr, 1)) = article_arr

Should do the trick. As you can see it will paste the range starting at A8 and going down the same length as the number of values in the array.

Answer 2

The most efficient/dynamic method for Array ⇒ Range :

There's an significantly more efficient way of placing data from a one- or two-dimensional array of values onto a worksheet, as long as it's a single area (ie., "no skipped cells" ).

A worksheet is basically a two-dimensional array.
However, interacting with the worksheet repeatedly (such as looping through every element in the array to populate one cell at a time) is an extremely expensive operation .

---

Call this procedure, passing it only an array and a single-cell range representing the desired "top-left corner" of the output data. Input array can be two-dimensional, or: one-dimension from a range."

Sub Array2Range(arr, destTL As Range)
    'dumps [arr] (1D/2D) onto a sheet where [destTL] is the top-left output cell.
    destTL.Resize(UBound(arr, 1) - LBound(arr, 1) + 1, _
        UBound(arr, 2) - LBound(arr, 2) + 1) = arr
End Sub

---

Examples:

Sub test_A2R()
    Dim myArr 'dimension a variant (variants can also hold implicit arrays!)

    'create a static two-dimensional (6x3) array
    myArr = [{1, 2, 3, "A", "D", "G"; 4, 5, 6, "B","E","H"; 7, 8, 9,"C","F","I"}]

    'dump the array onto the activesheet starting starting at cell [A1]
    Array2Range myArr, Range("A1")

End Sub

Sub test_R2A2R()
    Dim a 'dimension a variant
    a = Range("A1:E3")

    'do "something" to the data here (otherwise we should just use `Range.Copy`)
    'let's transpose the data, for no particular reason
    a = Application.WorksheetFunction.Transpose(a)

    Array2Range a, Range("C6") 'dump the array starting at Top-Left of [C5]
End Sub

Example Output:

Run both of the example subs and you'll get:

_{(Inspired by Chip Pearson )}

Answer 3

Following my comment, above (handling a one-dimensional array), suggesting this modest change to the answer by @ashleeDawg, above:

Sub sub_Array2Range(arrArray, rngSingleAreaTopLeftCell As Range)
    'dumps [arrArray] (1D/2D) onto a sheet
    ' where [rngSingleAreaTopLeftCell] is the top-left output cell.
On Error GoTo OneDimension
rngSingleAreaTopLeftCell.Resize(UBound(arrArray, 1) - LBound(arrArray, 1) + 1, _
        UBound(arrArray, 2) - LBound(arrArray, 2) + 1) = arrArray
Exit Sub

OneDimension:
    rngSingleAreaTopLeftCell _
       .Resize(UBound(arrArray, 1) - LBound(arrArray, 1) + 1) _
            = Application.Transpose(arrArray)
End Sub

See this question, for the problem cured by the transpose (without it, the the statement populates each cell in the range with the first array element):

Writing an array to a range. Only getting first value of array