3

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
Improve this question
4
  • Please provide some data, and example of desired output, so we can reproduce your problem. Please read the HELP topics for How to create a Minimal, Complete, and Verifiable example Commented Jul 25, 2016 at 13:03
  • 1
    If you managed to use the wrong variable, it means you aren't coding in Option Explicit. Write Option Explicit at the very top of your code, it will warn you about these things. Commented Jul 25, 2016 at 13:12
  • @RonRosenfeld Thanks for the input. I will also edit the questions with the solution that we have found. Commented Jul 25, 2016 at 13:53
  • @DavidG Thanks for the input, I am pretty new to VBA and this is great. Commented Jul 25, 2016 at 13:53

3 Answers 3

Reset to default
6

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:

img

(Inspired by Chip Pearson)

Improve this answer
Sign up to request clarification or add additional context in comments.

1 Comment

@ashleedawy -- does your Array2Range require a 2 dimensional array? What if the array is only one dimension? The UBound(arr,2) fails with a subscript out of bounds? Perhaps an "OnError goto OneDimension", before the statement, and a one dimensional version following the OneDimension: line number: destTL.Resize(UBound(arr, 1) - LBound(arr, 1) + 1 = arr
2

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.

Improve this answer

9 Comments

However even if you don't increment I would have assumed that at least j(0) was getting filled, you should be getting at least 1 value from your original code if it ever enters the if. F8 through that and see if you ever enter your if condition.
I use Debug.Print and pretty sure that the value enters the if. However using F8 the articleArr Value shows empty. Thanks for the increment of j. I totally forget about it.
Did you try it while incrementing j?
I realized, I used the wrong variable during the pasting the code 'Sheet7.Range("A8:A" & artCount) = articleArr()' I change it to article_Arr and it give me results. But it only paste the first value in the array. I will update the code in the question.
Thanks @David G. I just realised that the array in excel VBA is horizontal. Therefore addition of 'WorksheetFunction.Transpose(article_arr)' do the magic.
|
2

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

Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.