ExcelBanter - Rows to Columns - Diff Size Rows of Data

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Rows to Columns - Diff Size Rows of Data (https://www.excelbanter.com/excel-programming/423033-rows-columns-diff-size-rows-data.html)

Rows to Columns - Diff Size Rows of Data

Good Morning,

I have the following that I need to move into rows (records) - same
worksheet is fine. How can I do this when the address blocks are different
sizes (some 3 and some 4 rows)? There is a blank row in between.

Thanks so much in advance!

Mishelley

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Rows to Columns - Diff Size Rows of Data

Try some code like the following:

Sub AAA()
Dim LastCell As Long
Dim Dest As Range
Dim R As Range
Dim WS As Worksheet

' Dest is where the records are written
Set Dest = Worksheets("Sheet2").Range("A1")
' WS is worksheet with columnar data
Set WS = Worksheets("Sheet1")
With WS
LastCell = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
' R is first cell of columnar data
Set R = WS.Range("A1")
Do Until R.Row LastCell
Do Until R.Text = vbNullString
Dest = R.Text
Set Dest = Dest(1, 2)
Set R = R(2, 1)
Loop
Set Dest = Dest(2, 1).EntireRow.Cells(1, "A")
Set R = R(2, 1)
Loop
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

On Tue, 27 Jan 2009 04:47:02 -0800, Mishelley
wrote:

Good Morning,

I have the following that I need to move into rows (records) - same
worksheet is fine. How can I do this when the address blocks are different
sizes (some 3 and some 4 rows)? There is a blank row in between.

Thanks so much in advance!

Mishelley

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Rows to Columns - Diff Size Rows of Data

Sub transposeem()
lr = Cells(Rows.Count, 1).End(xlUp).Row
p1 = 2
cr = 1
Do Until p1 = lr
r1 = Cells(p1, 1).Row
r2 = Cells(p1, 1).End(xlDown).Row
Cells(r1, 1).Copy Cells(cr, 2)
Cells(r1 + 1, 1).Copy Cells(cr, 3)
If r2 - r1 = 3 Then
Cells(r1 + 2, 1).Copy Cells(cr, 4)
Cells(r1 + 3, 1).Copy Cells(cr, 5)
Else
Cells(r1 + 2, 1).Copy Cells(cr, 5)
End If
p1 = r2 + 2
cr = cr + 1
Loop
End Sub
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Mishelley" wrote in message
...
Good Morning,

I have the following that I need to move into rows (records) - same
worksheet is fine. How can I do this when the address blocks are
different
sizes (some 3 and some 4 rows)? There is a blank row in between.

Thanks so much in advance!

Mishelley

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Rows to Columns - Diff Size Rows of Data

Thank you very much for your help, Don. The code works perfectly!
Mishelley

"Don Guillett" wrote:

Sub transposeem()
lr = Cells(Rows.Count, 1).End(xlUp).Row
p1 = 2
cr = 1
Do Until p1 = lr
r1 = Cells(p1, 1).Row
r2 = Cells(p1, 1).End(xlDown).Row
Cells(r1, 1).Copy Cells(cr, 2)
Cells(r1 + 1, 1).Copy Cells(cr, 3)
If r2 - r1 = 3 Then
Cells(r1 + 2, 1).Copy Cells(cr, 4)
Cells(r1 + 3, 1).Copy Cells(cr, 5)
Else
Cells(r1 + 2, 1).Copy Cells(cr, 5)
End If
p1 = r2 + 2
cr = cr + 1
Loop
End Sub
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Mishelley" wrote in message
...
Good Morning,

I have the following that I need to move into rows (records) - same
worksheet is fine. How can I do this when the address blocks are
different
sizes (some 3 and some 4 rows)? There is a blank row in between.

Thanks so much in advance!

Mishelley

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Name
Address 1
City, State, Zip

Name
Address 1
Address 2
City, State, Zip

Rows to Columns - Diff Size Rows of Data