Need help transposing mailing list

[rkohlbeck]

Hello, I'm new to excel so bear with me.

I have a list like this:

John Doe
1234 Happy St
Anywhere, NC 11111
123-123-1234

Happy Guy
4321 Sad St
PO Box 12
Nowhere, WI 55555
321-321-4321

They are all in column A (2000 rows). There is a blank row before each new info section. So what I need is this list in columns.
Column A = Name
Column B = Street Address
Column C = Mailing Address

And so on. I've tried a few things, but I just can't get it all the way.

Thanks!

[AJ]

Is this the dreaded ACT??

Have a look at the following post and see if it's any use...

http://www.mrexcel.com/board/viewtop...c=1313&forum=2

[rkohlbeck]

Well, yes, It is exactly what I need. But it didn't work.

I ran it and it started pasting all the contents in Row 1. One right after another. I actually would like each Mailing record on a separate row. After a few seconds I received a run-time error '1004' something about an Application Defined or Object oriented error.

After going to the debugger it was stuck on this line:

ActiveCell.Offset(0, myIncrement).Select

I appreciate any further help.

[AJ]

Sorry about that. I'm sure that code did use to work!
Anyway, I've had another shot. Try this way instead (even commented my code for once - a real novelty!)

Sub Secondattempt()

Dim LastRow As Integer
Dim PasteRow As Integer

' Set PasteRow
PasteRow = 1
' Data starts in Cell A1
Range("A1").Select
' Start Loop
Do While ActiveCell.Value <> Empty
' Select all cells in current address
Range(Selection, Selection.End(xlDown)).Select
' Determine what last row is (we need this later)
LastRow = Selection.End(xlDown).Row
' Copy the current selection
Selection.Copy
' Select where to paste
Range("B" & PasteRow).Select
' Paste
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
' Delete the first address
Range("A1:A" & LastRow + 1).Select
Selection.Delete Shift:=xlUp
' Increase Pasterow by 1
PasteRow = PasteRow + 1
' Start again
Range("A1").Select
Loop
' Delete Column A because it's now empty
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

End Sub

[rkohlbeck]

Thanks AJ for your all your help, but it still doesn't work.

I get a runtime error:

The information cannot be pasted because the copy area and the paste area are not the same size and shape. Try one of the following:
+ Click a single cell, then paste
+ select a rectangle that's the same size and shape, then paste.

When I click the Debug button, It highlights this line:

Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

You are a trooper! I have no clue what is going on.

[Henry]

Ryan: Did you read my suggestion.

Mike (210) 498-1459

[AJ]

Hello again,

I think the problem might me that the blank lines in between each address are not utterly empty.
Can you check one of the blank cells and see whether there's actually a space in it or something like that.
If there is then the
Range(Selection, Selection.End(xlDown)).Select
would actually select pretty much the whole damned column and that would be more than 256 items, which would not fit into the 256 columns we have in Excel and give you the error when we try to PasteSpecial Transpose.

I'll assume that this is the problem for the moment and try and adjust the code accordingly.

P.S. Feel free to email me the file. It might help me.

[AJ]

If the "Blank" rows do in fact contain spaces, then try this...

Sub Thirdattempt()

Dim LastRow As Integer
Dim PasteRow As Integer

' Set PasteRow
PasteRow = 1
' Data starts in Cell A1
Range("A1").Select
' Start Loop
Do While ActiveCell.Value <> Empty
' Go down current address and find out where it ends (looking for a cell with a space)
Do While ActiveCell.Value <> " "
ActiveCell.Offset(1, 0).Select
LastRow = ActiveCell.Row
Loop
' N.B. LastRow is now actually the blank row
' Copy the current selection
Range("A1:A" & LastRow - 1).Select
Selection.Copy
' Select where to paste
Range("B" & PasteRow).Select
' Paste
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
' Delete the first address
Range("A1:A" & LastRow).Select
Selection.Delete Shift:=xlUp
' Increase Pasterow by 1
PasteRow = PasteRow + 1
' Start again
Range("A1").Select
Loop
' Delete Column A because it's now empty
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

End Sub

Any improvement??

Rgds
AJ

[rkohlbeck]

Well, we got by that error. It keeps running down until a runtime errors out with a overflow.
my list is about 1800 lines. it ran straight down to 32768 before the oveflow came.

When I hit Debug it stopped here:

LastRow = ActiveCell.Row

Sorry about this. I hate to use anyone's time. Henry suggested an Add-in I might try, "PuP". I'll keep looking if you want to keep trying, but I'll understand if we can't get this.

Thanks All

[Henry]

PuP will fix it--guaranteed. I think I paid $60 or so.

Besides that Transpose thing (go to Range inl the menu), it's got a bunch of neat things I used all the time. I'm surprised MS hasn't jumped on their band wagon and updated there version. Again, you can use if for a while (free trial period). If you get stuck (almost impossible) loading the Add-In, let me know. You'll flip when you see this thing in action. I think it was made by that John Walkenbach guy or something like that. Let me know what you do--just curious.

Henry