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

Rick - Jun 30, 2009 at 11:23 AM - 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 

20 replies

Best answer
mubashir aziz 191 Posts Sunday April 12, 2009Registration date February 16, 2010 Last seen - Jul 1, 2009 at 01:20 AM
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 .....





Thank you, mubashir aziz 5

Something to say? Add comment

CCM has helped 1665 users this month

mubashir aziz

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

Rick
mubashir aziz 191 Posts Sunday April 12, 2009Registration date February 16, 2010 Last seen > Rick - Jul 2, 2009 at 12:56 AM
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 ...

red > mubashir aziz 191 Posts Sunday April 12, 2009Registration date February 16, 2010 Last seen - Dec 22, 2009 at 07:25 PM
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?

Any help you can offer would be greatly appreciated!
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?
venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Jun 30, 2009 at 09:37 PM
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 <> ""
'MsgBox c.Address

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 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen > Rick - Jul 1, 2009 at 08:04 PM
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 <> ""
'MsgBox c.Address
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
Rick > venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Jul 1, 2009 at 09:27 PM
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!
venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Dec 22, 2009 at 10:47 PM
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.

heading
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)
add = rfind.Address
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 rfind.Address = add Then Exit Do
'msgbox rfind.Address

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
codenamered 2 Posts Tuesday December 22, 2009Registration date December 23, 2009 Last seen - Dec 23, 2009 at 11:13 AM
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):
heading
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

heading
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 1: heading
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
venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Dec 23, 2009 at 08:43 PM
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)
add = rfind.Address
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 rfind.Address = add Then Exit Do
'msgbox rfind.Address

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!!!
venkat1926 1865 Posts Sunday June 14, 2009Registration dateContributorStatus July 30, 2015 Last seen - Mar 26, 2010 at 10:58 PM
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)
add = rfind.Address
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 rfind.Address = add Then
'Exit Do
j = Range("A1").End(xlDown).Row
Set rfind = Cells.FindPrevious(after:=Range("A" & j))
'MsgBox rfind.Address
k = rfind.Row + 1
GoTo line1
End If

'MsgBox rfind.Address

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.

http://wiki.glitchdata.com/index.php?title=Google_Spreadsheet:_Converting_Rows_to_Columns_using_Transpose
thomaswinter85 6 Posts Friday October 14, 2011Registration date December 13, 2011 Last seen - Oct 14, 2011 at 07:06 AM
0
Thank you
thanks all..this helped me too.