Converting multiple rows and columns to a single row

[JCD1078]

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:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]John Smith[/TD]
[TD](111) 111-1111[/TD]
[/TR]
[TR]
[TD]111 Any Road[/TD]
[TD](222) 222-2222[/TD]
[/TR]
[TR]
[TD]Anytown, NY 11111[/TD]
[TD]anyemail@anyemail.com[/TD]
[/TR]
</tbody>[/TABLE]

...and convert it to this format:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]John Smith[/TD]
[TD]111 Any Road[/TD]
[TD]Anytown, NY 11111[/TD]
[TD](111) 111-1111[/TD]
[TD](222) 222-2222[/TD]
[TD]anyemail@anyemail.com[/TD]
[/TR]
</tbody>[/TABLE]

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.)

 

[johnmpl]

Hi!

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

Two VBA codes for answer this:

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:

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!

 

[JLGWhiz]

This would do it.

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]

JCD1078,

Thanks for the Private Message.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	John Smith	(111) 111-1111
2	111 Any Road	(222) 222-2222
3	Anytown, NY 11111	anyemail@anyemail.com
4	JCD1078	(333) 333-3333
5	333 Any Road	(333) 444-4444
6	Anytown, NY 33333	JCD1078@anyemail.com
7	hiker95	(444) 333-3333
8	444 Any Road	(444) 444-4444
9	Anytown, NY 44444	kiker95@anyemail.com
10
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	John Smith	(111) 111-1111		John Smith	111 Any Road	Anytown, NY 11111	(111) 111-1111	(222) 222-2222	anyemail@anyemail.com
2	111 Any Road	(222) 222-2222		JCD1078	333 Any Road	Anytown, NY 33333	(333) 333-3333	(333) 444-4444	JCD1078@anyemail.com
3	Anytown, NY 11111	anyemail@anyemail.com		hiker95	444 Any Road	Anytown, NY 44444	(444) 333-3333	(444) 444-4444	kiker95@anyemail.com
4	JCD1078	(333) 333-3333
5	333 Any Road	(333) 444-4444
6	Anytown, NY 33333	JCD1078@anyemail.com
7	hiker95	(444) 333-3333
8	444 Any Road	(444) 444-4444
9	Anytown, NY 44444	kiker95@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.

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]

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

 

[hiker95]

JCD1078,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.

 

[JCD1078]

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?

 

[hiker95]

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.

 

[JCD1078]

Excel 2012
	D
4	1
5
6
Sheet1

Cell Formulas
Range	Formula
A1	John Smith
A2	111 Any Road
A3	Anytown, NY 11111
A4	Jane Smith
A5	222 Any Road
A6	Anytown, NY 11111
B1	(111) 111-1111
B2	(222) 222-2222
B3	anyemail@email.com
B4	(333) 333-3333
B5	(444) 444-4444
B6	anyemail2@email.com
C1	100
C4	100
D1	1
D4	1

 

[JCD1078]

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.