Previous Topic Next Topic

Moving data from rows into columns for every

Solved/Closed
Rick - 30 Jun 2009 à 11:23
 Glitchdata - 10 Dec 2013 à 01:12
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

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





Rick
1 Jul 2009 à 09:55
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
Rick
1 Jul 2009 à 09:57
mubashir aziz

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

Rick
mubashir aziz Posts 190 Registration date Sunday 12 April 2009 Status Member Last seen 16 February 2010 166 > Rick
2 Jul 2009 à 00:56
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 Posts 190 Registration date Sunday 12 April 2009 Status Member Last seen 16 February 2010
22 Dec 2009 à 19:25
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!
Dory
23 Jun 2010 à 18:48
This is brillant! I tried a few thing but this works great! Thanks!!!
Réponse 2 / 7
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 811
30 Jun 2009 à 21:37
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
Rick
1 Jul 2009 à 09:38
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 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 811 > Rick
1 Jul 2009 à 20:04
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 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021
1 Jul 2009 à 21:27
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
fishface
20 Oct 2009 à 03:45
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!
Réponse 3 / 7
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 811
22 Dec 2009 à 22:47
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
Réponse 4 / 7
codenamered Posts 2 Registration date Tuesday 22 December 2009 Status Member Last seen 23 December 2009
23 Dec 2009 à 11:13
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
Réponse 5 / 7
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 811
23 Dec 2009 à 20:43
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
codenamered
26 Mar 2010 à 16:06
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!!!
Réponse 6 / 7
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 811
26 Mar 2010 à 22:58
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
red
20 Jul 2010 à 12:15
Venkat - this is long overdue...

THANK YOU SO MUCH!!!

It is perfect for my needs!

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

Similar discussions

Hosted app data will not clear
Woody_3336 -
woody_3336 -

7 responses
Copying data from one Excel sheet to another.
Remedial -
Kav -

30 responses
Unlock safe folder without losing any data
Mintu -
HelpiOS -

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

2 responses