CODEWITHSUNDEEP
excelvba
rmbradburn
rmbradburn

Reputation: 308

Why is my array breaking the column when I use TRANSPOSE to paste it into a worksheet?

In Excel, I'm using VBA to create an array to collect data and then pasting it back into a worksheet. This functioned excellently on a smaller dataset (~15,000 rows), but when I move to my larger dataset (~117,000 rows), something is happening at the "Transpose" step.

In the array, I have headers and data that I want to paste into 5 columns in a new sheet starting at cell B5. I define the range ("ListDestination"), then paste it in using this code:

shNew.Name = shName
Set ListDestination = shNew.Range("B5").Resize(UBound(arrList, 2), UBound(arrList, 1))
ListDestination = WorksheetFunction.Transpose(arrList)

When I check the ListDestination in the immediate window, it is correct ($B$5:$F$116771) and in the Watches window, I can see that the arrList is defined (1 to 5, 0 to 116767), which is correct. When expanding it, it also shows the data in the correct places. However, after the "Transpose" line, the result in the worksheet is:

Spreadsheet screenshot

...whereas it should be:

Corrected screenshot

For what it's worth, it does paste through the entire "ListDestination" range, but after row 51236 all I get is #N/A:

Column break screenshot

I haven't changed anything in the code since this worked on the smaller dataset, so I'm thinking it must have something to do with the size of the dataset.

Thanks for any help you can provide.

Upvotes: 1

Views: 367

Answers (2)

VBasic2008
VBasic2008

Reputation: 54815

The Limited Transpose Function

The Solution

Using the transpose2D function you could do one of the following:

' Note the '+ 1' since the lower limit of the second dimension is '0'.
Set ListDestination _
    = shNew.Range("B5").Resize(UBound(arrList, 2) + 1, UBound(arrList, 1))
ListDestination.Value = transpose2D(arrList)

' No need for '+ 1' since '1' is used with 'transpose2D'.
Dim Data As Variant: Data = transpose2D(arrList, 1)
Set ListDestination _
    = shNew.Range("B5").Resize(UBound(Data, 1), UBound(Data, 2))
ListDestination.Value = Data

' No need for '+ 1' since '1' is used with 'transpose2D'.
arrList = transpose2D(arrList, 1)
Set ListDestination _
    = shNew.Range("B5").Resize(UBound(arrList, 1), UBound(arrList, 2))
ListDestination.Value = arrList

The Function

Function transpose2D( _
    ByVal TwoD As Variant, _
    Optional ByVal FirstIndex As Variant) _
As Variant
    
    Dim LB1 As Long: LB1 = LBound(TwoD, 1)
    Dim UB1 As Long: UB1 = UBound(TwoD, 1)
    Dim LB2 As Long: LB2 = LBound(TwoD, 2)
    Dim UB2 As Long: UB2 = UBound(TwoD, 2)
    
    Dim Data As Variant, r As Long, c As Long
    
    If IsMissing(FirstIndex) Then ' just transpose
        ReDim Data(LB2 To UB2, LB1 To UB1)
        For r = LB2 To UB2
            For c = LB1 To UB1
                Data(r, c) = TwoD(c, r)
            Next c
        Next r
    Else ' transpose with (possibly) modified limits: LB1 = LB2 = FirstIndex
        Dim D1 As Long: D1 = FirstIndex - LB1
        Dim D2 As Long: D2 = FirstIndex - LB2
        ReDim Data(FirstIndex To UB2 + D2, FirstIndex To UB1 + D1)
        For r = LB2 To UB2
            For c = LB1 To UB1
                Data(r + D2, c + D1) = TwoD(c, r)
            Next c
        Next r
    End If
    
    transpose2D = Data

End Function

A Simple Example

Sub transpose2DTEST()
    
    Dim TwoD As Variant: ReDim TwoD(1 To 2, 0 To 3) ' Note the zero (0)
    
    Dim r As Long, c As Long, n As Long
    
    For r = 1 To UBound(TwoD, 1)
        For c = 0 To UBound(TwoD, 2)
            n = n + 1
            TwoD(r, c) = n
        Next c
    Next r
    
    ' Contents of TwoD:
    ' TwoD(1, 0) = 1
    ' TwoD(1, 1) = 2
    ' TwoD(1, 2) = 3
    ' TwoD(1, 3) = 4
    ' TwoD(2, 0) = 5
    ' TwoD(2, 1) = 6
    ' TwoD(2, 2) = 7
    ' TwoD(2, 3) = 8
    
    Dim Data As Variant
    
    Data = transpose2D(TwoD) ' just tranpose (note the zero)
    ' Contents of Data:
    ' Data(0, 1) = 1
    ' Data(0, 2) = 5
    ' Data(1, 1) = 2
    ' Data(1, 2) = 6
    ' Data(2, 1) = 3
    ' Data(2, 2) = 7
    ' Data(3, 1) = 4
    ' Data(3, 2) = 8
    
    Data = transpose2D(TwoD, 1) ' FirstIndex = 1
    ' Contents of Data:
    ' Data(1, 1) = 1
    ' Data(1, 2) = 5
    ' Data(2, 1) = 2
    ' Data(2, 2) = 6
    ' Data(3, 1) = 3
    ' Data(3, 2) = 7
    ' Data(4, 1) = 4
    ' Data(4, 2) = 8

End Sub

The Transpose Test

This was run on a 64bit Office version: no errors. As I recall the limit on a 32bit version was 65535 and afterward (>65535) it would raise an error.

Sub TransposeTest64bit()
    Dim Data As Variant: ReDim Data(1 To 65536, 1 To 1)
    Data = Application.Transpose(Data)
    Debug.Print LBound(Data), UBound(Data) ' 1, 65536
    ReDim Data(1 To 65537, 1 To 1)
    Data = Application.Transpose(Data)
    Debug.Print LBound(Data), UBound(Data) ' 1, 1
End Sub

Upvotes: 2

Scott Craner
Scott Craner

Reputation: 152525

Here is a simple function that will transpose the array.

Function my_transpose(arr As Variant) As Variant()
    Dim tempArray() As Variant
    ReDim tempArray(LBound(arr, 2) To UBound(arr, 2), LBound(arr, 1) To UBound(arr,1)) As Variant
    
    
    Dim i As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        Dim j As Long
        For j = LBound(arr, 2) To UBound(arr, 2)
            tempArray(j, i) = arr(i, j)
        Next j
    Next i
    
    my_transpose = tempArray
    
End Function

Then you would use in your line like this:

shNew.Name = shName
Set ListDestination = shNew.Range("B5").Resize(UBound(arrList, 2), UBound(arrList, 1))
ListDestination = my_transpose(arrList)

Upvotes: 3

Related Questions