how to change existed data in array vba

Question

In Excel, I have a list of items with their weight. I've made a function in VBA which picks random items out of the list as long as the total weight is under 10.
Before this function I made an array of only zero's which should belong each to an item. When the random function picks an item, this place in the array should change into an one, but this part of the function doesn't work.
Can anyone help me to solve this problem/repair the function?
This is my code:

Sub Test()

Dim weight As Single, totWeight As Single
Dim finish As Boolean
Dim r As Integer
Const maxWeight = 10

'Here it makes an array of only zero's
Dim Arr(1 To 66) As String, i As Integer
    For r = 1 To 66 
        Arr(r) = 0
    Next r

Do Until finish = True  
    'Pick random row out of my Excel sheet
    r = Int((65 * Rnd()) + 2)

    'The first are the titles (item, weight), so that's why I start from row 2
    If (totWeight + Cells(r, 2)) < maxWeight Then
        'Sum the picked weight up to the total weight 
        totWeight = totWeight + Cells(r, 2) 

        'Change the position of the item in the array into a 1
        'But it doesn't work
-->      Arr(r) = 1

    Else
        'Do as long as the weight is under 10
        finish = True
    End If
Loop

'It only prints zero's 
PrintArray Arr, ActiveWorkbook.Worksheets("Sheet1").[F1]

End Sub

(btw, this is the print function:
Sub PrintArray(Data As Variant, Cl As Range)
    Cl.Resize(UBound(Data, 1)) = Data
End Sub) 

Answer 1

I debuged your code, and it seems that problem is in your print function. Try this one

Sub PrintArray(Data As Variant, Cl As Range)
    Dim i As Integer
    For i = LBound(Data) To UBound(Data)
        Cl.Cells(i, 1).Value = Data(i)
    Next i
End Sub

If you are interested why your solution didnt work, i think its because you tried to assign array into value. So always when need to copy array, do it item by item...

Answer 2

The reason it seemed like you were not putting ones into the array is because the array was oriented backwards to the way you were dumping the array elements' values back into the worksheet. Essentially, you were filling all 66 cells with the value from the first element (e.g. arr(1)). If you did this enough times, sooner or later the random r var would come out as 1 and the first element of the array would receive a 1. In this case, all of the cells would be ones.

With your single dimension array, you can use the Excel Application object's TRANSPOSE function to flip your array from what is essentially 1 row × 66 columns into 66 rows × 1 column.

Sub PrintArray(Data As Variant, Cl As Range)
    Cl.Resize(UBound(Data)) = Application.Transpose(Data)
End Sub

That is a bit of a bandaid fix and the Application.Transpose has some limits (somewhere around an unsigned int - 1).

If you are creating an array for the end purpose of populating an range of cells on a worksheet, start with a 2 dimensioned array and stick with it. Keep the rank of the array correct and you won't have any problems dumping the values back into the worksheet.

Sub Test()
    Dim weight As Single, totWeight As Single
    Dim r As Long
    Const maxWeight = 10

    'Here it makes an array of only zero's
    Dim Arr(1 To 66, 1 To 1) As String, i As Integer
    For r = LBound(Arr, 1) To UBound(Arr, 1)
        Arr(r, 1) = 0
    Next r

    With ActiveWorkbook.Worksheets("Sheet1")
        Do While True
            'Pick random row out of my Excel sheet
            r = Int((65 * Rnd()) + 2)

            'The first are the titles (item, weight), so that's why I start from row 2
            If (totWeight + .Cells(r, 2)) < maxWeight Then
                'Sum the picked weight up to the total weight
                totWeight = totWeight + .Cells(r, 2)

                'Change the position of the item in the array into a 1
                Arr(r, 1) = 1 '<~~

            Else
                'just exit - no need to set a boolean
                Exit Do
            End If
        Loop

        PrintArray Arr, .Range("F2")
    End With
End Sub

Sub PrintArray(Data As Variant, Cl As Range)
    Cl.Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End Sub

This won't make much difference with 66 rows but with respect to Luboš Suk and his excellent answer, looping through 100K cells to stuff arrayed values back into a worksheet is pretty slow by array standards and we use arrays on reasonably large data blocks because they are faster. Dumping the values back en masse is almost instantaneous.