Label Format to Column Format

[drakehouse]

I've tried the offset command and a loop macro (which it's been several
years, so have been unsucessful) for the following scenario:

In column A, I have several contacts pasted in address label format.
I'd like to get them in column format. Column A currently looks like:

John Doe
123 Anywhere Lane
Mountains, CA 95555
(555) 555-5555


Jane Doe
1111 Anywhere Lane
Oceans, CA 97777
(555) 555-7777

There are two blank rows between the two contacts, which is what is
hanging me up.

Thanks so much!
A

 

[Dave Peterson]

Saved from a previous post...

Those blank cells are really empty??? They're not just formulas that evaluate
to ""? And are those cells in column A all values (constants) or all formulas
or a mixture of the two?

If those blank cells are really empty and all the cells are constants, then this
should work:

Option Explicit
Sub testme()
Dim BigRange As Range
Dim SmallArea As Range

With ActiveSheet
Set BigRange = Nothing
On Error Resume Next
Set BigRange = .Range("a:a").Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If BigRange Is Nothing Then
MsgBox "no constants in this column!"
Exit Sub
End If

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

On Error Resume Next
.Range("b:b").Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

.Range("a:a").Delete

End With
End Sub

There's no error checking to see if the number of cells exceeds the number of
columns--any chance that could happen?

 

[drakehouse]

You are a genius!

This worked like a charm. There will always only be four columns so I
think this will work. Thank you so much ... you saved me *much*
headache.
- Amber

 

[Gord Dibben]

Sub ColtoRows()
Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
On Error Resume Next
nocols = InputBox("Enter Number of Columns Desired")
If nocols = "" Or Not IsNumeric(nocols) Then Exit Sub
For i = 1 To rng.Row Step nocols
Cells(j, "A").Resize(1, nocols).Value = _
Application.Transpose(Cells(i, "A").Resize(nocols, 1)) _
j = j + 1
Next
Range(Cells(j, "A"), Cells(rng.Row, "A")).ClearContents
End Sub

Enter 6 in the "Number of Columns" inputbox.

Assumes there is no data in columns E and F

Of course you could first get rid of the blank rows by
F5>Special>Blanks>OK>Edit>Delete>Entire Rows
Then enter 4 in "Number of Columns"


Gord Dibben MS Excel MVP