Change every group of rows to columns

[Excel4biz]

I have groups of cells that are different number of rows long. What differentiates the groups is a space in between them. I would like to be able to change every row from A within a group into a new Colum. For example:
INPUT

​

[TABLE="width: 719"]
<tbody>[TR]
[TD][TABLE="width: 298"]
<tbody>[TR]
[TD]3/S Carwash Service[/TD]
[/TR]
[TR]
[TD]4635 S. Harlem[/TD]
[/TR]
[TR]
[TD]Forest View, IL 60402[/TD]
[/TR]
[TR]
[TD]Phone:708-749-4075[/TD]
[/TR]
[TR]
[TD]Fax:N/A[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]A-1 High Pressure Self Serve Car Wash Equipment & Service[/TD]
[/TR]
[TR]
[TD]5226 S 132 Street[/TD]
[/TR]
[TR]
[TD]Omaha, NE 68137[/TD]
[/TR]
[TR]
[TD]Phone:402-895-5544[/TD]
[/TR]
[TR]
[TD]Fax:N/A[/TD]
[/TR]
</tbody>[/TABLE]


OUTPUT
[TABLE="width: 456"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]3/S Carwash Service[/TD]
[TD]4635 S. Harlem[/TD]
[TD]Forest View[/TD]
[TD]IL[/TD]
[TD="align: right"]60402[/TD]
[TD]Phone:708-749-4075[/TD]
[TD]Fax:501-378-0102[/TD]
[/TR]
[TR]
[TD]A-1 High Pressure[/TD]
[TD]5226 S 132 Street[/TD]
[TD]Omaha[/TD]
[TD]NE[/TD]
[TD="align: right"]68137[/TD]
[TD]Phone:402-895-5544[/TD]
[TD]Fax:N/A[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I'm using Excel 2011

Thanks

 

[hiker95]

Excel4biz,

Welcome to the MrExcel forum.


Sample raw data:

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	3/S Carwash Service
2	4635 S. Harlem
3	Forest View, IL 60402
4	Phone:708-749-4075
5	Fax:N/A
6
7	A-1 High Pressure Self Serve Car Wash Equipment & Service
8	5226 S 132 Street
9	Omaha, NE 68137
10	Phone:402-895-5544
11	Fax:N/A
12
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	3/S Carwash Service		Name	Address	City	State	Zip	Phone	Fax
2	4635 S. Harlem		3/S Carwash Service	4635 S. Harlem	Forest View	IL	60402	708-749-4075	N/A
3	Forest View, IL 60402		A-1 High Pressure Self Serve Car Wash Equipment & Service	5226 S 132 Street	Omaha	NE	68137	402-895-5544	N/A
4	Phone:708-749-4075
5	Fax:N/A
6
7	A-1 High Pressure Self Serve Car Wash Equipment & Service
8	5226 S 132 Street
9	Omaha, NE 68137
10	Phone:402-895-5544
11	Fax:N/A
12
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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 11/07/2012
' http://www.mrexcel.com/forum/excel-questions/668372-change-every-group-rows-columns.html
Dim r As Long, lr As Long, nr As Long, s, t
Application.ScreenUpdating = False
Columns("C:I").ClearContents
Cells(1, 3).Resize(, 7).Value = [{"Name","Address","City","State","Zip","Phone","Fax"}]
lr = Cells(Rows.Count, 1).End(xlUp).Row
nr = 1
For r = 1 To lr Step 6
  nr = nr + 1
  Cells(nr, 3).Resize(, 2).Value = Application.Transpose(Cells(r, 1).Resize(2).Value)
  s = Split(Cells(r + 2, 1), ", ")
  Cells(nr, 5).Value = s(0)
  t = Split(s(1), " ")
  Cells(nr, 6).Resize(, 2).Value = t
  Cells(nr, 8) = Right(Cells(r + 3, 1), Len(Cells(r + 3, 1)) - 6)
  Cells(nr, 9) = Right(Cells(r + 4, 1), Len(Cells(r + 4, 1)) - 4)
Next r
Columns("C: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.