CODEWITHSUNDEEP
excelvba
Pingu
Pingu

Reputation: 11

Why when reading my array onto cells in VBA does it repeat every row?

My code simply reads:

Board = Array(1,2,3,4,5,6,7,8,9)
Range("A1:C3") = Board

But when executed repeats 1, 2, 3 across the rows A1 to C1, A2 to C2 and A3 to C3. How do I fix this?

Upvotes: 0

Views: 84

Answers (3)

VBasic2008
VBasic2008

Reputation: 54807

Fill Range with Array

  • Only run the first procedure which calls the second which calls the third.
  • Note that a range can be 'filled' by rows and by columns.
  • Change the values in the first procedure to understand the full potential.

The Code

Option Explicit

Sub TESTfillRangeWithArray()
    Dim Board As Variant: Board = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
    Dim rng As Range: Set rng = Range("A1:C3")
    ' Either...
    fillRangeWithArray rng, Board ' By Rows
    ' ...or
    'fillRangeWithArray rng, Board, True ' By Columns
End Sub

Sub fillRangeWithArray( _
        ByRef rng As Range, _
        OneD As Variant, _
        Optional ByVal ByColumns As Boolean = False)
    ' Indexes
    Dim FirstIndex As Long: FirstIndex = LBound(OneD)
    Dim LastIndex As Long: LastIndex = UBound(OneD)
    Dim n As Long: n = FirstIndex - 1
    ' Limits
    Dim rCount As Long: rCount = rng.Rows.Count
    Dim cCount As Long: cCount = rng.Columns.Count
    ' Data Array
    Dim Data As Variant
    If rCount > 1 Or cCount > 1 Then
        ReDim Data(1 To rCount, 1 To cCount)
    Else
        ReDim Data(1 To 1, 1 To 1)
    End If
    ' Counters
    Dim i As Long
    Dim j As Long
    ' Loop
    If Not ByColumns Then
        For i = 1 To rCount
            For j = 1 To cCount
                determineIndex n, FirstIndex, LastIndex
                Data(i, j) = OneD(n)
            Next j
        Next i
    Else
        For j = 1 To cCount
            For i = 1 To rCount
                determineIndex n, FirstIndex, LastIndex
                Data(i, j) = OneD(n)
            Next i
        Next j
    End If
    ' Result
    rng.Value = Data
End Sub
Private Sub determineIndex( _
        ByRef CurrentIndex As Long, _
        ByVal FirstIndex As Long, _
        ByVal LastIndex As Long)
    ' Indexes
    If CurrentIndex < LastIndex Then
        CurrentIndex = CurrentIndex + 1
    Else
        CurrentIndex = FirstIndex
    End If
End Sub

Upvotes: 1

T.M.
T.M.

Reputation: 9948

Flexible way to slice "flat" array data into range

I assume that Pingu wants to repart a flat array onto the example range.

Furthermore I've been spurred on to this approach by @ScottCraner citing

"You set up a 1D array, that is one row; you will need to make the array the shape you want before trying to post it to the cells. VBA will not automatically set the array to the shape."

The following function Sliced()` not only tries to this profiting from

  • a) some evalutions to get the numeric items order,
  • b) the advanced features of the `Application.Index() function to allow rearranging,

but also to allow a fully flexibilized execution with any column number needed:

Function sliced(arr, Optional ByVal cols As Long = 1)
'Purpose: slice 1-dim array into given number of columns and flexible number of rows
'a) adjust 1-based item numbers into 2-dim array
    Dim tmp: tmp = Join(Application.Transpose(Evaluate("row(1:" & cols & ")")), ",")
    Dim c: c = Evaluate("row(1:" & UBound(arr) \ cols + 1 & ")*" & cols & "+{" & tmp & "}-" & cols)
'b) return 2dim array sliced into given number of columns and flexible number of rows
    sliced = Application.Index(arr, 1, c)
End Function

Example Call

Sub ExampleCall()
'[0]Given input
    Dim board: board = Array(10, 20, 30, 40, "50", 60, 70, 80, 90)
    Const cols As Long = 3          ' << intended number of columns
'[1]get results array
    Dim results: results = sliced(board, cols)
'[2]write to any target
    Sheet1.Range("A1").Resize(UBound(results), cols) = results
End Sub

Upvotes: 1

BigBen
BigBen

Reputation: 49998

Use a 2D array:

Dim Board(1 To 3, 1 To 3) As Variant 'or As Long

Dim i As Long, j As Long
For i = LBound(Board, 1) To UBound(Board, 1)
    For j = LBound(Board, 2) To UBound(Board, 2)
        Dim counter As Long
        counter = counter + 1
        Board(i, j) = counter
    Next
Next

Range("A1:C3").Value = Board

Upvotes: 2

Related Questions