PDA

View Full Version : [SOLVED] Need Help restructuring this Macro for large amount of data. Please



estatefinds
07-28-2016, 12:33 PM
Hello, I have data that I would like to be converted from Column A to Rows.


The data is numerical starting at 1 to 324632 in the column A.
I need the macro to be able to place the data in the rows.

For example: place the 1 from column A1 to the column E1 and the 2 from column A2 to the column F1. so it has to be 35 across and I believe it will be over 9,275 rows down.



Thank you Very much in advance!!!

I am attaching the file shortly with macro attached the file is too big Im just trying to get it under the MB limit to attach.

SamT
07-28-2016, 03:11 PM
A simple brute force technique


Sub Brutus()
Dim Src as Range
Dim Dest As Range
Set Src = Range("A:A")
Set Dest = Range("E:AM") 'Set 35th column letter. I just guessed
For i = 1 to 324632
Dest.Cells(i) = Src.Cells(i)
Next i
End Sub

estatefinds
07-28-2016, 03:28 PM
I worked Great!!!! thank you very much!!!! :)

Paul_Hossler
07-28-2016, 03:57 PM
I'd just chunk it over in blocks since it's faster that one cell at a time, esp for 300K+ cells, and the number of rows is not hardcoded




Option Explicit

Sub test1()
Const nCol As Long = 35
Dim N As Long
Dim rStart As Range, rEnd As Range
Dim iDown As Long, iAcross As Long

Set rStart = ActiveSheet.Cells(1, 1)
Set rEnd = rStart.End(xlDown)

N = Range(rStart, rEnd).Cells.Count

iAcross = 1
ActiveSheet.Cells(iAcross, 5).CurrentRegion.Clear

Application.ScreenUpdating = False

For iDown = 1 To N Step nCol
ActiveSheet.Cells(iDown, 1).Resize(nCol, 1).Copy
ActiveSheet.Cells(iAcross, 5).PasteSpecial Paste:=xlPasteAll, Transpose:=True
iAcross = iAcross + 1
Next iDown

Application.ScreenUpdating = True
End Sub

estatefinds
07-28-2016, 05:36 PM
Excellent!!! Thank you!:)

SamT
07-28-2016, 06:17 PM
@ Paul,

Nice code. If I was going to do that in 'production,' I would 'steal' it as is with the only change be to use two arrays instead of the two Ranges.

Paul_Hossler
07-28-2016, 07:24 PM
@ Paul,

Nice code. If I was going to do that in 'production,' I would 'steal' it as is with the only change be to use two arrays instead of the two Ranges.


1. Tanks

2. I actually started with arrays, but I changed direction because I didn't have a fast way to move 'chunks' from the Col A big array to the little array 35 cells at a time other than by looping 35 times

3. Would like to know a good way to do that

jolivanes
07-28-2016, 10:46 PM
Disclaimer.
Not my code. I would never be able to put something like this together.
Adapted code from KjBox at
http://www.ozgrid.com/forum/showthread.php?t=188720



Sub kjbox()
'http://www.ozgrid.com/forum/showthread.php?t=188720
Dim x, y, i As Long, j As Long, k As Long
Dim t
t = Timer
x = Range("a1", Cells(Rows.Count, 1).End(xlUp))
ReDim y(1 To (UBound(x, 1) / 35) + 1, 1 To 35)
k = 1
For i = 1 To (UBound(x, 1) / 35) + 1
For j = 1 To 35
y(i, j) = x(k, 1)
k = k + 1: If k = UBound(x, 1) + 1 Then Exit For
Next
If k = UBound(x, 1) + 1 Then Exit For
Next
[E1].Resize(UBound(y, 1), 35) = y
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub


With 325,000 cells in Column A:
KjBox's code 0.31 seconds
Paul's code 17.84 seconds

jolivanes
07-28-2016, 10:54 PM
Might as well attach a trial workbook

SamT
07-29-2016, 08:53 AM
2. I actually started with arrays, but I changed direction because I didn't have a fast way to move 'chunks' from the Col A big array to the little array 35 cells at a time other than by looping 35 times

3. Would like to know a good way to do that

Speedwise, a Range in memory is very close to an array. (It really is just a special Array)

Blending Yours, Jolivane's , and mine


LastRow = (LastRow/35 +1) * 35
Set Src = Range("A1:A" & LastRow)
Redim DestArray(LastRow/35, 35)
Then transpose 35 cell chunks of Src to DestArray.


If Brutus took minutes, yours took seconds, and Jolivane's took 1/3 second, that should be done before the User can lift his finger off the Mouse button