Power Query Course in Spanish
Thanks Thanks:  0
Likes Likes:  0
Page 2 of 2 FirstFirst 12
Results 11 to 12 of 12

Thread: Need help transposing mailing list

  1. #11
    Board Regular
    Join Date
    Mar 2002
    Location
    Mike T.
    Posts
    180
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  2. #12
    Board Regular
    Join Date
    Mar 2002
    Location
    =ActiveCell.Address
    Posts
    478
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Ryan,
    On having had a look at the file you sent, the reason things weren't quite working was variable "entries" in the "blank" rows. Some had nothing in, some had a single space and others had a double space. Changing my last code to allow for this, we have...

    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 <> " " And ActiveCell.Value <> " " And ActiveCell.Value <> Empty
    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

    Which now works!
    Rgds
    AJ

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •