Transpose & Split a Column into multiple Rows

[iridius]

I have a spreadsheet with data in Column A.
Each particular collection of data is seperated by a single empty row
in Column A.
Each particular collection of data ranges from 1 row of data to 10 or
more rows of data.

I need to get the data so that each particular collection of data is
on a seperate row.
I want the first piece of data from each seperate collection to be in
Column A, the second in Column B. But each new collection of data
must start on a new row.

Below is a short bit of what I have followed by what I want.

********************** I HAVE***********************
United States

Alabama

University of Alabama
School of Medicine
Medical Student Services
VH 100
1530 Third Avenue South
Birmingham, AL 35294-0019
E-mail:
(e-mail address removed)
(205) 934-2330
AMCAS // Deadline Information // Public

University of South Alabama
College of Medicine
Office of Admissions, 241 CSAB
Mobile, AL 36688-0002
(334) 460-7176 //
AMCAS // Deadline Information // Public

Arizona


******************* I WANT (I put ............. to imply the row
continues in Excel *******************
United States
Alabama
University of Alabama | School of Medicine | Medical Student
Services .................
University of South Alabama | College of Medicine | Office of
Admissions, 241 CSAB..............
Arizona

 

[Dave Peterson]

You could use a macro.

This assumes that there are no formulas in column A--it's all just values.

Option Explicit
Sub testme()
Dim BigRng As Range
Dim SmallArea As Range
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

With wks
Set BigRng = Nothing
On Error Resume Next
Set BigRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If BigRng Is Nothing Then
MsgBox "No constants in column A!"
Exit Sub
End If

For Each SmallArea In BigRng.Areas
SmallArea.Copy
SmallArea.Cells(1).Offset(0, 1).PasteSpecial Transpose:=True
Next SmallArea

On Error Resume Next
.Range("b1").EntireColumn.Cells _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

.Range("a1").EntireColumn.Delete
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[iridius]

You could use a macro.

This assumes that there are no formulas in column A--it's all just values.

Option Explicit
Sub testme()
Dim BigRng As Range
Dim SmallArea As Range
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

With wks
Set BigRng = Nothing
On Error Resume Next
Set BigRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If BigRng Is Nothing Then
MsgBox "No constants in column A!"
Exit Sub
End If

For Each SmallArea In BigRng.Areas
SmallArea.Copy
SmallArea.Cells(1).Offset(0, 1).PasteSpecial Transpose:=True
Next SmallArea

On Error Resume Next
.Range("b1").EntireColumn.Cells _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

.Range("a1").EntireColumn.Delete
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:http://www.mvps.org/dmcritchie/excel/getstarted.htm










--

Dave Peterson- Hide quoted text -

- Show quoted text -

Thanks that worked great, and it was one of the first macros I've had
that had no errors 1st go.... thanks.

 

[Dave Peterson]

Well, there were errors in the code before I posted it! <vbg>

Glad it worked for you.