# Converting multiple rows and columns to a single row

#### JCD1078

##### New Member
I am hoping someone can help me solve this formatting issue I have. I need to be able to take the data I receive in the following format:

 John Smith (111) 111-1111 111 Any Road (222) 222-2222 Anytown, NY 11111 anyemail@anyemail.com

<tbody>
</tbody>

...and convert it to this format:

 John Smith 111 Any Road Anytown, NY 11111 (111) 111-1111 (222) 222-2222 anyemail@anyemail.com

<tbody>
</tbody>

If I consider the 3 lines of original data to be 1 "record", the file I receive initially has hundreds of "records." The format of the original data will always be 2 columns and 3 rows. Is there a macros that can be created to help streamline this process? I'd truly appreciate any assistance given. (I also apologize, I don't have a full version of Excel at home and I'm not able to install anything on my work computer.)

### Excel Facts

Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

#### johnmpl

##### Board Regular
Hi!

I supose that your data starts in A1, and write the answer in D1

Two VBA codes for answer this:

Code:
``````Sub ReOrg()
Dim M, F&, Q&, A&, i&, it!, j&

it = Timer
F = Range("A1").CurrentRegion.Rows.Count
Q = Application.RoundUp(F / 3, 0)
ReDim M(1 To Q, 1 To 6)

For i = 1 To F Step 3
A = A + 1
'        For j = 1 To 6
'            M(A, j) = Cells(i + (j - 1 Mod 3), Int((j - 1) / 3) + 1)
'        Next j
M(A, 1) = Cells(i, 1)
M(A, 2) = Cells(i + 1, 1)
M(A, 3) = Cells(i + 2, 1)
M(A, 4) = Cells(i, 2)
M(A, 5) = Cells(i + 1, 2)
M(A, 6) = Cells(i + 2, 2)
Next i

With Range("D1")
.CurrentRegion.ClearContents
.Resize(A, 6) = M
.CurrentRegion.EntireColumn.AutoFit
End With
MsgBox Format(Timer - it, "0.000 secs.")
End Sub``````

And another option:

Code:
``````Sub ReOrg2()
Dim F&, A&, i&, it!
F = Range("A1").CurrentRegion.Rows.Count

it = Timer
Application.ScreenUpdating = 0
With Range("D1")
.CurrentRegion.Clear
For i = 1 To F Step 3
.Offset(A).Resize(, 3) = Application.Transpose(Cells(i, 1).Resize(3))
.Offset(A, 3).Resize(, 3) = Application.Transpose(Cells(i, 2).Resize(3))
A = A + 1
Next i
.CurrentRegion.EntireColumn.AutoFit
End With
Application.ScreenUpdating = 1
MsgBox Format(Timer - it, "0.000 secs.")
End Sub``````

I prefer the first way (3 to 4 times faster in +/- 2000 regs.)

I leave a several lines commented, like an option to resume the 6 lines into the for in 3 lines (with a For - To - Next and variable j). Also, I show a message box with the time taken for the code for reorganize your data.

I Hope it helps! God Bless You!

#### JLGWhiz

##### Well-known Member
This would do it.
Code:
``````Sub xpose()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1) 'Edit sheet name
Range("C1:H1").EntireColumn.Insert
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lr Step 3
With sh
.Cells(i, 1).Resize(3, 1).Copy
.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial Transpose:=True
.Cells(i, 2).Resize(3, 1).Copy
.Cells(Rows.Count, 6).End(xlUp)(2).PasteSpecial Transpose:=True
End With
Next
Application.CutCopyMode = False
Columns("A:B").Delete
End Sub``````

#### hiker95

##### Well-known Member
JCD1078,

Thanks for the Private Message.

Sample raw data:

Excel 2007
ABCDEFGHI
1John Smith(111) 111-1111
3Anytown, NY 11111anyemail@anyemail.com
4JCD1078(333) 333-3333
6Anytown, NY 33333JCD1078@anyemail.com
7hiker95(444) 333-3333
9Anytown, NY 44444kiker95@anyemail.com
10
Sheet1

After the macro using two arrays in memory:

Excel 2007
ABCDEFGHI
1John Smith(111) 111-1111John Smith111 Any RoadAnytown, NY 11111(111) 111-1111(222) 222-2222anyemail@anyemail.com
3Anytown, NY 11111anyemail@anyemail.comhiker95444 Any RoadAnytown, NY 44444(444) 333-3333(444) 444-4444kiker95@anyemail.com
4JCD1078(333) 333-3333
6Anytown, NY 33333JCD1078@anyemail.com
7hiker95(444) 333-3333
9Anytown, NY 44444kiker95@anyemail.com
10
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
``````Sub ReorgData()
' hiker95, 08/27/2014, ME80784
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("D1:I" & lr).ClearContents
a = Range("A1:B" & lr)
ReDim o(1 To lr / 3, 1 To 6)
For i = 1 To lr Step 3
j = j + 1
o(j, 1) = a(i, 1)
o(j, 2) = a(i + 1, 1)
o(j, 3) = a(i + 2, 1)
o(j, 4) = a(i, 2)
o(j, 5) = a(i + 1, 2)
o(j, 6) = a(i + 2, 2)
Next i
Range("D1:I" & lr / 3) = o
Columns("D:I").AutoFit
Application.ScreenUpdating = True
End Sub``````

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

#### JCD1078

##### New Member
You guys are absolutely awesome. This is perfect! Thank you so much!

#### hiker95

##### Well-known Member
JCD1078,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.

#### JCD1078

##### New Member
Another question if you wouldn't mind... They changed the data on me and added two columns to the initial format I posted. Columns 3 and 4 (the newly added columns) are each columns that are merged across 3 rows? So for example:

Cell A1 John Smith
Cell A3 Anytown, NY 11111
Cell B1 (111) 111-1111
Cell B2 (222) 222-2222
Cell B3 anyemail@email.com
Cell C1-3 (merged together) 100
Cell D1-3 (merged together) 0

How would the code change?

#### hiker95

##### Well-known Member
JCD1078,

Tanks for the Private Message.

I am not able to determine where the new data structure is, cells, rows, columns, by your description.

In order to continue I will need to see actual screenshots:

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

1. MrExcel HTMLMaker20101230
https://onedrive.live.com/?cid=8cffdec0ce27e813&sc=documents&id=8CFFDEC0CE27E813!189

Installation instructions here:
http://www.mrexcel.com/forum/board-announcements/515787-forum-posting-guidelines.html#post2545970

2. Excel Jeanie

If you are not able to give us screenshots:
sensitive data changed
mark the workbook for sharing

#### JCD1078

##### New Member

Excel 2012
D
41
5
6
Sheet1
Cell Formulas
RangeFormula
A1John Smith
A3Anytown, NY 11111
A4Jane Smith
A6Anytown, NY 11111
B1(111) 111-1111
B2(222) 222-2222
B3anyemail@email.com
B4(333) 333-3333
B5(444) 444-4444
B6anyemail2@email.com
C1100
C4100
D11
D41

Last edited:

#### JCD1078

##### New Member
For some reason it won't paste properly if I include more than one "record" of data. I can try again tomorrow if you can't figure out what I mean.

Replies
1
Views
86
Replies
3
Views
453
Replies
6
Views
131
Replies
3
Views
137
Replies
3
Views
179

1,190,564
Messages
5,981,704
Members
439,731
Latest member
auraitsuka

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back