Moving alternate rows of data to column

[Corsa88]

Hi guys, Im trying to put convert an initial N x 1 data, such that, for every 2nd term, it goes to the 2nd column and the 3rd term to the third column. This goes on for the remaining data.

e.g.

1
2
3
4
5
6
7
8
9

to become:

1	2	3
4	5	6
7	8	9

I have this small VBA script:

Sub MoveRange()
'Updateby20140730A
Dim rng As Range
Dim InputRng As Range, OutRng As Range
xTitleId = "Transform 2nd and 3rd row to 2nd and 3rd column"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set InputRng = InputRng.Columns(1)
For i = 1 To InputRng.Rows.Count Step 2
    OutRng.Resize(1, 3).Value = Array(InputRng.Cells(i, 1).Value, InputRng.Cells(i + 1, 1).Value, InputRng.Cells(i + 2, 1).Value)
    Set OutRng = OutRng.Offset(1)
Next
End Sub

However when running this, it gives me instead:

1	2	3
3	4	5
5	6	7
7	8	9

Can someone let me know what is wrong with my VBA code?

Thanks!

[JasperD]

Hi and welcome to the forum.

Please read the rules here as to format your code correctly.
also, please tell us your expected outcome.

[Corsa88]

Hi and welcome to the forum.

Please read the rules here as to format your code correctly.
also, please tell us your expected outcome.

Hi Jasper

Thank you for the reply, have formatted my code according to the guide.

[JasperD]

Sub excelforum()
Dim a, x&
a = Range("A1:A9"): 

For x = LBound(a) To UBound(a) Step 3
ActiveSheet.Cells(1 + Int(x / 3), 1) = a(x, 1)
ActiveSheet.Cells(1 + Int(x / 3), 2) = a(x + 1, 1)
ActiveSheet.Cells(1 + Int(x / 3), 3) = a(x + 2, 1)
Next x

End Sub

[Corsa88]

Sub excelforum()
Dim a, x&
a = Range("A1:A9"): 

For x = LBound(a) To UBound(a) Step 3
ActiveSheet.Cells(1 + Int(x / 3), 1) = a(x, 1)
ActiveSheet.Cells(1 + Int(x / 3), 2) = a(x + 1, 1)
ActiveSheet.Cells(1 + Int(x / 3), 3) = a(x + 2, 1)
Next x

End Sub

Hi Jasper

Thanks for the solution!

Would there a more general way of getting the range of 'a' ? I might possibly have data spanning greater than 9 rows (likely > 100 rows of data), manual input might be too cumbersome.

[JasperD]

You can put anything you want on the line where a is specified.

a = Range("A1:A9")

for example, all cells in column A:

a = Range("A1:A" & Cells(rows.count, 1).end(xlup).row)

shouldn't be too hard.

[Marc L]

Another way :

Sub Demo()
    With Cells(1).CurrentRegion:  VA = .Value:  .Clear:  End With

    With Cells(1).Resize(UBound(VA) / 3, 3)
        For N& = 1 To UBound(VA):  .Cells(N).Value = VA(N, 1):  Next
    End With
End Sub 

Do you like it ? So thanks to click on bottom left star icon « Add Reputation » !

[Marc L]

A full array way :

Sub Demo2()
    With Cells(1).CurrentRegion:  AR = .Value:  .Clear:  End With
    C = Array(3, 1, 2):   N& = UBound(AR) \ 3:   R& = 1
    ReDim VA(1 To N - (UBound(AR) > N * 3), 1 To 3)
    For N = 1 To UBound(AR):  M% = N Mod 3:  VA(R, C(M)) = AR(N, 1):  R = R - (M = 0):  Next
    Cells(1).Resize(UBound(VA), 3).Value = VA
End Sub 

Thanks for the rep' !

[Corsa88]

A full array way :

Sub Demo2()
    With Cells(1).CurrentRegion:  AR = .Value:  .Clear:  End With
    C = Array(3, 1, 2):   N& = UBound(AR) \ 3:   R& = 1
    ReDim VA(1 To N - (UBound(AR) > N * 3), 1 To 3)
    For N = 1 To UBound(AR):  M% = N Mod 3:  VA(R, C(M)) = AR(N, 1):  R = R - (M = 0):  Next
    Cells(1).Resize(UBound(VA), 3).Value = VA
End Sub 

Thanks for the rep' !

Ah, may i know what is the difference between this and the previous one? Both seem to work well with large data

[Marc L]

Ah, may i know what is the difference between this and the previous one?
Both seem to work well with large data

Demo2 could be faster with large data (writes cells range at once)
'cause first Demo has not display off (see ScreenUpdating property) and writes a cell by a cell …

[Corsa88]

Demo2 could be faster with large data (writes cells range at once)
'cause first Demo has not display off (see ScreenUpdating property) and writes a cell by a cell …

I see, that has been extremely helpful. Many thanks Marc !

[FDibbins]

Please take a moment to read the forum rules and then amend your thread title to something descriptive of your problem - not what you think the answer might be. (think google search terms?). Once you have done this please send me a PM and I will remove this request. (Also, include a link to your thread - copy from the address bar)

Many members search our previous posts, and thread titles play a big part of the search. I doubt anybody would do a search based on your title?

To change a Title on your post, click EDIT POST then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

(note: this change is not optional )

[Corsa88]

Please take a moment to read the forum rules and then amend your thread title to something descriptive of your problem - not what you think the answer might be. (think google search terms?). Once you have done this please send me a PM and I will remove this request. (Also, include a link to your thread - copy from the address bar)

Many members search our previous posts, and thread titles play a big part of the search. I doubt anybody would do a search based on your title?

To change a Title on your post, click EDIT POST then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

(note: this change is not optional )

Sure, I made a change to the title. Do see if the title description is adequate?