 # Moving data from rows into columns for every [Solved/Closed]

- - Latest reply:  Glitchdata - Dec 10, 2013 at 01:12 AM
Hello,

I have data in a single column and would like to transpose it into a row for every three rows with a space delimiter, for example; The column of data varies in the amount of data each time.

A
B
C
D
E
F
G
H
I
J
etc

into

A B C
D E F
G H I
J etc

Thank you in advance for any advise or solution that will help me solve this issue.
Rick
See more

## 7 replies

Posts
191
Registration date
Sunday April 12, 2009
Status
Member
Last seen
February 16, 2010
209
5
Thank you
Suppose your data is in A1:A50 or A500 ........ then a work sheet function approach is ....

`B2=OFFSET(A1,2*(ROW()-1),0)&" "&OFFSET(A1,2*(ROW()-1)+1,0)&" "&OFFSET(A1,2*(ROW()-1)+2,0)`

and drag it down ..... 5907 users have said thank you to us this month

mubashir aziz

I meant to say merge every three rows not every third row. My appologies.

Rick
I think my formula just giving you the result as you are getting from macro !!!! Sorry i'm completely stumped. Can you give me some example if you are still unable to get the solution ...

Hi, I wonder if you can help me, as well. This is an example of column A of my spreadsheet:

US - UNITED STATES
3
5
US - UNITED STATES
36
US - UNITED STATES
35

I'd like the numbers to appear in the same row as the US - UNITED STATES that appears above them. As you see, it is variable whether the data contains two numbers or just one that must be moved up.

Also, is it possible to make it so that the 3 and 5 would appear in the same cell separated by a comma?

This is brillant! I tried a few thing but this works great! Thanks!!!
Hi Mubashir,

The formula that you gave works best for me but I have 4 rows not three. Can you please suggest?
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784
0
Thank you
suppose the data are in A2 down with A1 having column headings.

try this macro

the results will be in columns C to E

the macro is
[code]
Sub test()
Dim rng As Range, m As Integer, c As Range
Columns("c:E").Delete
m = 3
Set rng = Range(Range("a2"), Range("a2").End(xlDown))
Set c = Range("a2")
Do While c <> ""

Range(c, c.Offset(m - 1, 0)).Copy
Cells(Rows.Count, "c").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Set c = c.Offset(m, 0)
Loop

End Sub
/code
venkat1926

Thank you for taking the time to help me on this. I apologize that I was not clear in my support question, however, all of the data needs to be space delimited in a single column. Can you suggest a code change that will take each of the three rows, place a space between each and place them in a separate column. Thank you again as this will save hours of time for me.

Rick
venkat1926
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784 > Rick -
try this macro test1 which is an amended version of my previous macro

Sub test1()
Dim rng As Range, m As Integer, c As Range, C1 As Range, x As String
Columns("c").Delete
m = 3
Set rng = Range(Range("a2"), Range("a2").End(xlDown))
Set c = Range("a2")
Do While c <> ""
x = ""
For Each C1 In Range(c, c.Offset(m - 1, 0))
x = x & " " & C1
Next C1
Cells(Rows.Count, "c").End(xlUp).Offset(1, 0) = Trim(x)

Set c = c.Offset(m, 0)
Loop

End Sub
> venkat1926
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
-
venkat1926,

Thank you for helping me leverage this and save this soul from working extensive hours in massaging this data. I help I can learn more to help others like you have done for me.

Many thanks again,

Rick
this works brilliantly. I had a long column with 4 sets of data repeated and this helped me to transpose into 4 columns. great thanks keep posting!
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784
0
Thank you
I have added one row before the first us-united states in case the first such string is not in row 2(row 1 is headings)
if the first string is in row 2 then also the macro will take care of it.
As this changes your data in column A you copy the original data before running the macro into sheet 2
so that this can be retrieved. both sheet1 and sheet 2 are like this.

2
US - UNITED STATES
3
5
US - UNITED STATES
36
US - UNITED STATES
35

try this macro and see sheet 1

POST CONFIRMATION WHETHER THE MACRO DOES WHAT YOU WANT

The macro is

Sub test()
Dim x As String, rfind As Range, add As String, y As String
Dim rprev As Range, j As Integer, k As Integer, m As Integer
undo
x = "US - UNITED STATES"
On Error Resume Next
Worksheets("sheet1").Activate
Set rfind = Cells.Find(what:=x, lookat:=xlPart)
If rfind.Row = 2 Then
GoTo nnext
Else
k = 2
j = rfind.Row - 1
y = rfind
For m = k To j

y = y & "," & Cells(m, 1)
'msgbox y
If j = k Then GoTo outloop
Next m
outloop:
'msgbox y
rfind = y
End If
nnext:
Do

Set rfind = Cells.FindNext(after:=rfind)
If rfind Is Nothing Then Exit Do

If Not rfind Is Nothing Then
Set rprev = Cells.FindPrevious(rfind)

j = rfind.Row
j = j - 1
k = rprev.Row
k = k + 1
y = rfind
'msgbox k
'msgbox j
For m = k To j

y = y & "," & Cells(m, 1)
'msgbox y
If j = k Then GoTo getout
Next m
getout:
'msgbox y
rfind = y
End If
Loop
End Sub

```Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").UsedRange.Copy _
Worksheets("sheet1").Range("A1")
End Sub```
Posts
2
Registration date
Tuesday December 22, 2009
Status
Member
Last seen
December 23, 2009
0
Thank you
I appreciate your help! I apologize, I don't believe my question was very clear.

I ran the macro and my data appeared, as such for column A (it is very close to what I need):
2
US - UNITED STATES,2
3
5
US - UNITED STATES,3,5
36
US - UNITED STATES,36
35

Let me try to ask my question again. My original data would appear like this:

column A

US - UNITED STATES
3
5
US - UNITED STATES
36
US - UNITED STATES
35

And the result I wish to see is:

in column A:
row 2: US - UNITED STATES
row 3: US - UNITED STATES
row 4: US - UNITED STATES

and in column B:
row 1:
row 2: 3, 5
row 3: 36
row 4: 35
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784
0
Thank you
try this modified macros.
even though all the three macros must be available in the standard module you have to run only the macro "test"
The macro "test" incorporates the other two modules. my version windows xp excel 2002

It is a good practice if the extract of data as you have done and also the result data are posted in the first thread, it would be helpful to help. It is also be good practice to post confirmation if the solution helps.

As I mentioned in the previous thread as you are messing up with the data, the data should be copied in sheet 2.
the macro "undo" (embedded in "test") will automatically clears sheet1 and copies original data from sheet 2.

the revised macros are

```Sub test()
Dim x As String, rfind As Range, add As String, y As String
Dim rprev As Range, j As Integer, k As Integer, m As Integer
undo
x = "US - UNITED STATES"
On Error Resume Next
Worksheets("sheet1").Activate
Set rfind = Cells.Find(what:=x, lookat:=xlPart)
If rfind.Row = 2 Then
GoTo nnext
Else
k = 2
j = rfind.Row - 1
'y = rfind
For m = k To j

y = y & "," & Cells(m, 1)
'msgbox y
If j = k Then GoTo outloop
Next m
outloop:
'msgbox y
'msgbox Mid(y, 2, Len(y) - (k - 1))
rfind.Offset(0, 1) = Mid(y, 2, Len(y) - (k - 1))
End If
nnext:
Do

Set rfind = Cells.FindNext(after:=rfind)
If rfind Is Nothing Then Exit Do

If Not rfind Is Nothing Then
Set rprev = Cells.FindPrevious(rfind)

j = rfind.Row
j = j - 1
k = rprev.Row
k = k + 1
y = ""
'msgbox k
'msgbox j
For m = k To j

y = y & "," & Cells(m, 1)
'msgbox y
If j = k Then GoTo getout
Next m
getout:
'msgbox y
'msgbox Mid(y, 2, (k - 1))
rfind.Offset(0, 1) = Mid(y, 2, (k - 1))
End If
Loop
sorting
End Sub```

```Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").UsedRange.Copy _
Worksheets("sheet1").Range("A1")
End Sub```

```Sub sorting()
Dim j As Integer, k As Integer
Worksheets("sheet1").Activate
j = Cells(Rows.Count, "A").End(xlUp).Row
For k = j To 2 Step -1
If Cells(k, "B") = "" Then Cells(k, "B").EntireRow.Delete
Next
End Sub```
Thanks, Venkat. Almost there!

Original data:
Sheet 2
COLUMN A
Country
US - UNITED STATES
33
35
US - UNITED STATES
35
36
US - UNITED STATES
35
US - UNITED STATES
35
US - UNITED STATES
36
US - UNITED STATES
36
US - UNITED STATES
36

After running test:
Sheet 1
COLUMN A COLUMN B
Country
US - UNITED STATES 33
US - UNITED STATES 35,36
US - UNITED STATES 35
US - UNITED STATES 35
US - UNITED STATES 36
US - UNITED STATES 36

How do you add a space between the , and 36?

Thank you!!!
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784
0
Thank you
As the macros are few months old I have lost thread of the logic in the macros. I had to more or less re do it. any how I am giving the j macros as modified again. Remember main data is in first sheet 2. The macro first clears the sheet 1 and copies data in sheet 2 to sheet1 and manipulate sheet1.
perhaps the macros are clumsy and may be tweaked a lot.
If it does the work it is ok.
run only the macro "test" but all the macros should be in the module.
```Sub test()
Application.ScreenUpdating = False
Dim x As String, rfind As Range, add As String, y As String
Dim rprev As Range, j As Integer, k As Integer, m As Integer
undo
x = "US - UNITED STATES"
On Error Resume Next
Worksheets("sheet1").Activate
Set rfind = Cells.Find(what:=x, lookat:=xlPart)
If rfind.Row = 2 Then
GoTo nnext
Else
k = 2
j = rfind.Row - 1
'y = rfind
For m = k To j

y = y & "," & " " & Cells(m, 1)
'msgbox y
If j = k Then GoTo outloop
Next m
outloop:
'msgbox y
'msgbox Mid(y, 2, Len(y) - (k - 1))
rfind.Offset(0, 1) = Mid(y, 2, Len(y) - (k - 1))
End If
nnext:
Do

Set rfind = Cells.FindNext(after:=rfind)
If rfind Is Nothing Then Exit Do
'Exit Do
j = Range("A1").End(xlDown).Row
Set rfind = Cells.FindPrevious(after:=Range("A" & j))
k = rfind.Row + 1
GoTo line1
End If

If Not rfind Is Nothing Then
Set rprev = Cells.FindPrevious(rfind)

j = rfind.Row
j = j - 1
k = rprev.Row
k = k + 1
'msgbox k
'msgbox j
line1:
For m = k To j

y = y & "," & " " & Cells(m, 1)
'msgbox y
If j = k Then GoTo getout
Next m
getout:

'msgbox y
'msgbox Mid(y, 2, (k - 1))
rprev.Offset(0, 1) = Mid(y, 3, Len(y) - 2)
End If
If j = Range("A1").End(xlDown).Row Then
Set rprev = Cells.FindPrevious(after:=Range("A" & j))
rprev.Offset(0, 1) = Mid(y, 3, Len(y) - 2)
GoTo line2
End If
y = ""
Loop
line2:
sorting
Application.ScreenUpdating = True
End Sub```

```Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").UsedRange.Copy _
Worksheets("sheet1").Range("A1")
End Sub```

```Sub sorting()
Dim j As Integer, k As Integer
Worksheets("sheet1").Activate
j = Cells(Rows.Count, "A").End(xlUp).Row
For k = j To 2 Step -1
If Cells(k, "B") = "" Then Cells(k, "B").EntireRow.Delete
Next
End Sub

```
Venkat - this is long overdue...

THANK YOU SO MUCH!!!

It is perfect for my needs!

Best wishes to you,
Red
Try using TRANSPOSE. This function is available in excel and in Google Spreadsheet.

Posts
6
Registration date
Friday October 14, 2011
Status
Member
Last seen
December 13, 2011
0
Thank you
thanks all..this helped me too.
Recommended

DON'T MISS