Converting multiple rows and columns to a single row

JCD1078

New Member
Joined
Aug 27, 2014
Messages
13
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 11111anyemail@anyemail.com

<tbody>
</tbody>

...and convert it to this format:

John Smith111 Any RoadAnytown, NY 11111(111) 111-1111(222) 222-2222anyemail@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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
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.

Please comment!
I Hope it helps! God Bless You!
 
Upvote 0
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
 
Upvote 0
JCD1078,

Thanks for the Private Message.

Sample raw data:


Excel 2007
ABCDEFGHI
1John Smith(111) 111-1111
2111 Any Road(222) 222-2222
3Anytown, NY 11111anyemail@anyemail.com
4JCD1078(333) 333-3333
5333 Any Road(333) 444-4444
6Anytown, NY 33333JCD1078@anyemail.com
7hiker95(444) 333-3333
8444 Any Road(444) 444-4444
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
2111 Any Road(222) 222-2222JCD1078333 Any RoadAnytown, NY 33333(333) 333-3333(333) 444-4444JCD1078@anyemail.com
3Anytown, NY 11111anyemail@anyemail.comhiker95444 Any RoadAnytown, NY 44444(444) 333-3333(444) 444-4444kiker95@anyemail.com
4JCD1078(333) 333-3333
5333 Any Road(333) 444-4444
6Anytown, NY 33333JCD1078@anyemail.com
7hiker95(444) 333-3333
8444 Any Road(444) 444-4444
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
2. Open your NEW workbook
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.
 
Upvote 0
JCD1078,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.
 
Upvote 0
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 A2 111 Any Road
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?
 
Upvote 0
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?

To post your data, you can download and install one of the following two programs:
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
Download


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Upvote 0

Excel 2012
D
41
5
6
Sheet1
Cell Formulas
RangeFormula
A1John Smith
A2111 Any Road
A3Anytown, NY 11111
A4Jane Smith
A5222 Any Road
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:
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top