Previous Topic Next Topic

Moving data from rows into columns for every

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

7 responses

Answer 1 / 7
mubashir aziz Posts 190 Registration date Sunday April 12, 2009 Status Member Last seen February 16, 2010 166
Jul 1, 2009 at 01:20 AM
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 .....





5
Rick
Jul 1, 2009 at 09:55 AM
mubashir aziz

Thank you for your response however, I need to automate this on a weekly cycle. The data comes in a text format which I suck into the spreadsheet and then have automated script to massage the data. The last part that I am having difficulty in is to merge every third row and space delimit it into another row or worksheet. From there the data gets exported out again into a text file and imported into the application.

Thanks,
Rick
0
Rick
Jul 1, 2009 at 09:57 AM
mubashir aziz

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

Rick
0
mubashir aziz Posts 190 Registration date Sunday April 12, 2009 Status Member Last seen February 16, 2010 166 > 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 ...

0
red > mubashir aziz Posts 190 Registration date Sunday April 12, 2009 Status Member Last seen February 16, 2010
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!
0
Dory
Jun 23, 2010 at 06:48 PM
This is brillant! I tried a few thing but this works great! Thanks!!!
0
Answer 2 / 7
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 30, 2009 at 09:37 PM
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
0
Rick
Jul 1, 2009 at 09:38 AM
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
0
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811 > 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
0
Rick > venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021
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
0
fishface
Oct 20, 2009 at 03:45 AM
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!
0
Answer 3 / 7
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Dec 22, 2009 at 10:47 PM
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
0
Answer 4 / 7
codenamered Posts 2 Registration date Tuesday December 22, 2009 Status Member Last seen December 23, 2009
Dec 23, 2009 at 11:13 AM
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
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 7
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Dec 23, 2009 at 08:43 PM
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
0
codenamered
Mar 26, 2010 at 04:06 PM
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!!!
0
Answer 6 / 7
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Mar 26, 2010 at 10:58 PM
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
0
red
Jul 20, 2010 at 12:15 PM
Venkat - this is long overdue...

THANK YOU SO MUCH!!!

It is perfect for my needs!

Best wishes to you,
Red
0
Glitchdata
Dec 10, 2013 at 01:12 AM
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
0
Answer 7 / 7
thomaswinter85 Posts 6 Registration date Friday October 14, 2011 Status Member Last seen December 13, 2011
Oct 14, 2011 at 07:06 AM
thanks all..this helped me too.
0

Similar discussions

Unlock safe folder without losing any data
Mintu -
HelpiOS -

1 response
How To Fix Mint Mobile Data Not Working?
sachin327 -
joshitha -

2 responses
AMD data change update new data to DMI
Luis -
dwebb -

1 response