VB code won't write whole array to range; only first element?

[astrbac]

Hello,

I have the weirdest problem which I can't crack. I need to do the following:

• lift the range C2:AU264 into an 2D array
• create another 1D array
• fill second array with values from the first one ("transpose"
• write array 2 back to the sheet

Here is the code I am using:

Private Ws As Worksheet
Private budgets() As Variant
Private arrayToWrite() As Variant
Private lastrow As Long
Private lastcol As Long


Private Sub procedure()
Application.ScreenUpdating = False


Set Ws = Sheet19
Ws.Activate


lastrow = Ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
lastcol = Ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column


ReDim budgets(1 To lastrow - 1, 1 To lastcol - 2)
budgets= Ws.Range("C2:AU265")




ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1))


k = 0
For j = 1 To UBound(budgets, 2)
    For i = 1 To UBound(budgets, 1)
      arrayToWrite(i + k) = budgets(i, j)
    Next i
    k = k + lastrow - 1
Next j
 


Set Ws = Sheet6
Ws.Activate


Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = arrayToWrite


'For i = 1 To UBound(arrayToWrite)
    'Ws.Range(Cells(i + 1, 5).Address).Value = arrayToWrite(i)
'Next i


Application.ScreenUpdating = True
End Sub

This just writes the first value from the range C2:AU264 (the first element of the first array) through the whole range. Ih however, I un-comment the for loop just before the end of my script and do it that way, it does work. It takes awful lot of time, like couople of minutes or so.

What am I doing wrong? Thanks!

 

[Rhodie72]

I am intrigued as to why you must write data that is already in memory to another array in memory 46 or 264 times and then paste the data into the sheet. Surely it would be quicker and easier to transpose the data from the 1st array directly and cut out the extra code and time wasting?

 

[Jon von der Heyden]

I think you need:

Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = Application.Transpose(arrayToWrite)

The reason it takes so long when you do 1 at a time, I suspect, is recalculation. I.e. each time you unload an item to a range it may be that recalc is being kicked-off... The writing and unloading itself should be very quick.

 

[Rhodie72]

Hello,

I have the weirdest problem which I can't crack. I need to do the following:

• lift the range C2:AU264 into an 2D array
• create another 1D array
• fill second array with values from the first one ("transpose"
• write array 2 back to the sheet

Here is the code I am using:

Private Ws As Worksheet
Private budgets() As Variant
Private arrayToWrite() As Variant
Private lastrow As Long
Private lastcol As Long


Private Sub procedure()
Application.ScreenUpdating = False


Set Ws = Sheet19
Ws.Activate


lastrow = Ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
lastcol = Ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column


ReDim budgets(1 To lastrow - 1, 1 To lastcol - 2)
budgets= Ws.Range("C2:AU265")




ReDim arrayToWrite(1 To (lastCol - 2) * (lastRow - 1))


k = 0
For j = 1 To UBound(budgets, 2)
    For i = 1 To UBound(budgets, 1)
      arrayToWrite(i + k) = budgets(i, j)
    Next i
    k = k + lastrow - 1
Next j
 


Set Ws = Sheet6
Ws.Activate


Ws.Range("E2").Resize(UBound(arrayToWrite)).Value = arrayToWrite


'For i = 1 To UBound(arrayToWrite)
    'Ws.Range(Cells(i + 1, 5).Address).Value = arrayToWrite(i)
'Next i


Application.ScreenUpdating = True
End Sub

This just writes the first value from the range C2:AU264 (the first element of the first array) through the whole range. Ih however, I un-comment the for loop just before the end of my script and do it that way, it does work. It takes awful lot of time, like couople of minutes or so.

What am I doing wrong? Thanks!

Sub populate()
Dim OG(1 To 44, 1 To 264), x As Double, y As Double, z As Double

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False

        OG = Range("C2:AU264")
        'Range("C2:AU264").ClearContents
        ActiveCell.CurrentRegion.ClearContents
        'replicant = Range("C1:JF45")
        For x = 1 To 44 'Rows down
            For y = 2 To 265 'columns accross
                'z = 'z + 1
                Debug.Print OG(x, y)
                ActiveCell.Offset(1, 3).Cells(y, x).Value = OG(x, y)
            Next y
            z = x + y + z
        Next x
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    x = 0: y = 0
End Sub

As you can see, this is the way to transpose it. It's already in the format x,y in the array but when you transpose it it shoud be reveresed to y,x from the array. There's no need for complicated coding as far as I can see.

 

[Peter_SSs]

• lift the range C2:AU264 into an 2D array
• create another 1D array
• fill second array with values from the first one ("transpose"
• write array 2 back to the sheet

If your purpose is to get that single column range filled from the multi-column range, is there any reason you wouldn't just use a slight adaptation of the one-liner that pgc01 gave you a few months ago for a very similar problem here?

The adaptation would be:

Sub procedure2()
  Sheet6.Range("E2:E11836").Value = Application.Index(Sheet19.Range("C2:AU264"), Evaluate("if(row($A$2:$A$11836),mod(ROW($A$2:$A$11836)-ROW($A$2),ROWS(C2:AU264))+1)"), Evaluate("if(row($A$2:$A$11836),INT((ROW($A$2:$A$11836)-ROW($A$2))/ROWS(C2:AU264))+1)"))
End Sub

 

[RoryA]

What am I doing wrong? Thanks!

Your issue is that a 1D array is treated as being a row when you assign it to a range. A simple fix is to use a 2D array with a second dimension sized 1 to 1:

ReDim arrayToWrite(1 To (lastcol - 2) * (lastrow - 1), 1 To 1)


k = 0
For j = 1 To UBound(budgets, 2)
    For i = 1 To UBound(budgets, 1)
      arrayToWrite(i + k, 1) = budgets(i, j)
    Next i
    k = k + lastrow - 1
Next j