Looping problem that make procedure too long

[rozek]

Hi. Appreciate any solution to this looping problem. I can't run the VB macro code due to procedure too long. The looping as below:

n = 5
For j = 5 To 7
Sheets("A").Cells(j, 121) = Sheets("A").Cells(5, n)
n = n + 1
Next j

n = 5
For j = 8 To 10
Sheets("A").Cells(j, 121) = Sheets("A").Cells(6, n)
n = n + 1
Next j

n = 5
For j = 11 To 13
Sheets("A").Cells(j, 121) = Sheets("A").Cells(7, n)
n = n + 1
Next j

need to do this until

n = 5
For j = 461 To 463
Sheets("A").Cells(j, 121) = Sheets("A").Cells(157, n)
n = n + 1
Next j

How can I make the looping simpler and not too long? Any help is much appreciated. Thank you

 

[Zot]

Will this work?

n = 5
For j = 1 To 3
    Sheets("A").Cells(4 + j, 121) = Sheets("A").Cells(5, n)
    Sheets("A").Cells(7 + j, 121) = Sheets("A").Cells(6, n)
    Sheets("A").Cells(10 + j, 121) = Sheets("A").Cells(7, n)
    Sheets("A").Cells(460 + j, 121) = Sheets("A").Cells(157, n)
    n = n + 1
Next j

 

[rozek]

Hi Zot. Thank you for the reply. Yeah it works. But the code is still long since we have the 4,7,10,...460 on the left hand side and the 5,6,7,....157 on the right side. Any way to change this into a one line statement like

Sheets("A").Cells(k + j, 121) = Sheets("A").Cells(i, n)

Thanks

 

[Anthony47]

A possible alternate solution:

Sub DoAll()
Dim wArr(), cArea As Range, dCol As Long
Dim I As Long, J As Long, aInd As Long
'
Set cArea = Range("E5:G157")    '<<< Area to be transposed
dCol = 121                      '<<< Destination column
'
ReDim wArr(1 To cArea.Count)
For I = 1 To cArea.Rows.Count
    For J = 1 To cArea.Columns.Count
        aInd = aInd + 1
        wArr(aInd) = cArea.Cells(I, J)
    Next J
Next I
Cells(5, dCol).Resize(UBound(wArr), 1).Value = Application.WorksheetFunction.Transpose(wArr)
End Sub

Try...

 

[offthelip]

this should bevery fast since it uses arrays:

inarr = Worksheets("A").Range("E5:G157") ' loadd all the input data
outarr = Worksheets("A").Range(Cells(5, 121), Cells(463, 121))
indi = 1
For i = 1 To UBound(inarr, 1)
 For j = 1 To 3
   outarr(indi, 1) = inarr(i, j)
   indi = indi + 1
 Next j
Next i
 Worksheets("A").Range(Cells(5, 121), Cells(463, 121)) = outarr
 Worksheets("A").Range(Cells(5, 12), Cells(463, 12)) = outarr
 
End Sub

 

[rozek]

Thank you Anthony47. Really short & sweet. Met the objective. Cheers mate.

 

[rozek]

this should bevery fast since it uses arrays:

inarr = Worksheets("A").Range("E5:G157") ' loadd all the input data
outarr = Worksheets("A").Range(Cells(5, 121), Cells(463, 121))
indi = 1
For i = 1 To UBound(inarr, 1)
 For j = 1 To 3
   outarr(indi, 1) = inarr(i, j)
   indi = indi + 1
 Next j
Next i
 Worksheets("A").Range(Cells(5, 121), Cells(463, 121)) = outarr
 Worksheets("A").Range(Cells(5, 12), Cells(463, 12)) = outarr
 
End Sub

Thanks offthelip. This code rocks!. the power of arrays......

 

[Anthony47]

And indeed it takes 0.004 secs less that my macro
Thanks for the feedback

 

[offthelip]

I think it is worth learning how to use arrays for inputs and outputs because when you get a lot of data 1000000 rows it makes a huge difference. 4 milliseconds is not usually worth bothering about.

 

[Anthony47]

To avoid misunderstandings, I agree that working with cells is slow and it's better to copy ranges to array and then work with the data in memory. The wider the areas and the higher the loops trough the same data, the better the improvements.
Given that in this case the user data spans only 460 cells and they have to be cycled once then the improvements would be marginal.
See you on the forum