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

 

[hiker95]

JCD1078,

I can not figure it out.

 

[JCD1078]

Can't figure out the solution or what I'm asking?

 

[hiker95]

Jcd1078,

I can not make any sense out of your last two screenshots, in your reply #9.


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?

And, I will need detailed instructions.


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
	A	B	C	D
1	John Smith	(111) 111-1111	100	1
2	111 Any Road	(222) 222-2222
3	Anytown, NY 11111	anyemail@email.com
Sheet1

Cell Formulas
Range	Formula
A1	John Smith
A2	111 Any Road
A3	Anytown, NY 11111
B1	(111) 111-1111
B2	(222) 222-2222
B3	anyemail@email.com
C1	100
D1	1

 

[JCD1078]

Excel 2012
	A	B	C	D
4	Jane Smith	(333) 333-3333	100	1
5	222 Any Road	(444) 444-4444
6	Anytown, NY 11111	anyemail2@email.com
Sheet1

Cell Formulas
Range	Formula
A4	Jane Smith
A5	222 Any Road
A6	Anytown, NY 11111
B4	(333) 333-3333
B5	(444) 444-4444
B6	anyemail2@email.com
C4	100
D4	1

 

[JCD1078]

Excel 2012
	A	B	C	D	E	F	G	H
1	John Smith	111 Any Road	Anytown, NY 11111	(111) 111-1111	(222) 222-2222	anyemail@email.com	100	1
2	Jane Smith	222 Any Road	Anytown, NY 11111	(333) 333-3333	(444) 444-4444	anyemail2@email.com	100	1
Sheet2

Cell Formulas
Range	Formula
A1	John Smith
A2	Jane Smith
B1	111 Any Road
B2	222 Any Road
C1	Anytown, NY 11111
C2	Anytown, NY 11111
D1	(111) 111-1111
D2	(333) 333-3333
E1	(222) 222-2222
E2	(444) 444-4444
F1	anyemail@email.com
F2	anyemail2@email.com
G1	100
G2	100
H1	1
H2	1

 

[JCD1078]

The first two screen shots are the data. It wouldn't allow me to paste the table for both records at once. The third post is how I'd like the data to look.

 

[hiker95]

JCD1078,

I assume that worksheets Sheet1, and, Sheet2, already exist.

Sample worksheets:

Excel 2007
	A	B	C	D
1	John Smith	(111) 111-1111	100	1
2	111 Any Road	(222) 222-2222
3	Anytown, NY 11111	anyemail@email.com
4	Jane Smith	(333) 333-3333	100	1
5	222 Any Road	(444) 444-4444
6	Anytown, NY 11111	anyemail2@email.com
7
Sheet1

Excel 2007
	A	B	C	D	E	F	G	H
1
2
3
Sheet2

After the new macro (using two arrays in memory) in worksheet Sheet2:

Excel 2007
	A	B	C	D	E	F	G	H
1	John Smith	111 Any Road	Anytown, NY 11111	(111) 111-1111	(222) 222-2222	anyemail@email.com	100	1
2	Jane Smith	222 Any Road	Anytown, NY 11111	(333) 333-3333	(444) 444-4444	anyemail2@email.com	100	1
3
Sheet2

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

Sub ReorgData_V2()
' hiker95, 09/11/2014, ME80784
Dim w1 As Worksheet, w2 As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long, lc As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
With w1
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc)).Value
  ReDim o(1 To lr / 3, 1 To 8)
End With
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)
  o(j, 7) = a(i, 3)
  o(j, 8) = a(i, 4)
Next i
With w2
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(lr / 3, 8).Value = o
  .UsedRange.Columns.AutoFit
  .Activate
End With
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_V2 macro.

 

[JCD1078]

You're amazing! Thanks so much again!

 

[hiker95]

JCD1078,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.