Need help transposing mailing list - Page 2
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

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
  •  

 

 
DMCA.com