Array and loop to sheet optimizing

quarna

New Member
Joined
Oct 25, 2021
Messages
38
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub TestSpeed()

    sheet1.Range("A42") = Time()
    Dim r, k, i, j As Integer, rg As Range, arr As Variant
    Set rg = sheet1.Range("A1:BB40")
    arr = rg.Value
    k = 1
    r = 1
                                                                 
            For i = LBound(arr, 1) To UBound(arr, 1)
                For j = LBound(arr, 2) To UBound(arr, 2)
                    sheet2.Cells(r, k) = arr(i, j)
                    k = k + 1
                Next j
            Next i
                
    sheet1.Range("A43") = Time()
    
End Sub

It takes 3 full seconds.
Is it possible to write to sheet2 in 1 row faster, without using screenupdating and enableevents etc.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
How about:
VBA Code:
Sub TestSpeed()
    Sheet1.Range("A42") = Time()
    Dim k As Long, i As Long, j As Long, rg As Range, arr As Variant
    Set rg = Sheet1.Range("A1:BB40")
    arr = rg.Value
    
    ReDim var(UBound(arr) * UBound(arr, 2))
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            var(k) = arr(i, j)
            k = k + 1
        Next j
    Next i
    Sheet2.Range("A1").Resize(, UBound(var)) = var
    Sheet1.Range("A43") = Time()
End Sub
 
Upvote 0
Another option with a formula
Excel Formula:
=TOROW(Sheet1!A1:BB40)
 
Upvote 0
How about:
VBA Code:
Sub TestSpeed()
    Sheet1.Range("A42") = Time()
    Dim k As Long, i As Long, j As Long, rg As Range, arr As Variant
    Set rg = Sheet1.Range("A1:BB40")
    arr = rg.Value
   
    ReDim var(UBound(arr) * UBound(arr, 2))
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            var(k) = arr(i, j)
            k = k + 1
        Next j
    Next i
    Sheet2.Range("A1").Resize(, UBound(var)) = var
    Sheet1.Range("A43") = Time()
End Sub

Hi sorry for the extreme long response time :)
But your code had issues, it puts 34 blank cells in between the values.
But i managed to optimize my code with functions and some other stuff to make it run smoother, thats why i didnt get to you.
 
Upvote 0
Another option with a formula
Excel Formula:
=TOROW(Sheet1!A1:BB40)

Sadly this dont work on my version of excel (company version).
But what a great formula they have incorporated
 
Upvote 0
Ok, if you are interested in a formula another option is
Excel Formula:
=LET(Rng,Sheet1!A1:BB40,c,COLUMNS(Rng),s,SEQUENCE(c*ROWS(Rng),,0),INDEX(Rng,INT(s/c)+1,MOD(s,c)+1))
 
Upvote 0
Ok, if you are interested in a formula another option is
Excel Formula:
=LET(Rng,Sheet1!A1:BB40,c,COLUMNS(Rng),s,SEQUENCE(c*ROWS(Rng),,0),INDEX(Rng,INT(s/c)+1,MOD(s,c)+1))
Dude, how is this even posible, your have insane knowledge.

I used transpose in front to get it to a row, but it spills out "blue outline" not "fixed" numbers.
Hope you know what i mean.

Can it return as "fixed" instead of the spill ?

👏
 
Upvote 0
To put it into a row you can use
Excel Formula:
=LET(Rng,Sheet1!A1:BB40,c,COLUMNS(Rng),s,SEQUENCE(,c*ROWS(Rng),0),INDEX(Rng,INT(s/c)+1,MOD(s,c)+1))
and the whole idea is that it will spill, rather than having a formula in each cell.
 
Upvote 0
Solution
To put it into a row you can use
Excel Formula:
=LET(Rng,Sheet1!A1:BB40,c,COLUMNS(Rng),s,SEQUENCE(,c*ROWS(Rng),0),INDEX(Rng,INT(s/c)+1,MOD(s,c)+1))
and the whole idea is that it will spill, rather than having a formula in each cell.

Got it, thanks alot !! :)
 
Upvote 0
Glad to help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top