Super User is a question and answer site for computer enthusiasts and power users. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

What I have is a very large worksheet of data of names and addresses. Right now, it looks similar to:

               Name   Number       Address

There are hundreds upon hundreds of groups like this, all separated by at least one blank row. Now, I can use the transpose tool by hand, but this would take me quite some time. I thought about just writing a Macro to do it, however some addresses are three lines whereas some are four lines, so it confuses me on if that is even possible.

Any simple ways to do this without having to do all of it by hand?

share|improve this question
Are the 3 rows addresses contiguous with each other, or interspersed with the 4 row addresses. – Lance Roberts Nov 1 '10 at 20:42
up vote 2 down vote accepted

Now, i assume that you want the end result to look similar to the below with no lines in between individuals and the full address on one line in one cell

Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address

i am also going to assume that your data starts in cell A1 and that every name is unique. if it does not then the macro will need some minor tweaking. set Stopper = 50000 to the row after your last set of data, otherwise this could go on far longer than necessary (or not long enough perhaps).

Sub CollectThem()
    Dim All As New Collection
    Dim One As Variant
    Dim Addy As Variant, Stopper As Long, L1 As Integer

    Stopper = 645

    Cells(1, 1).Select
    Do Until ActiveCell.Row >= Stopper
        ReDim One(0 To 2)
        One(0) = ActiveCell.Offset(0, 0).Value
        One(1) = ActiveCell.Offset(0, 1).Value
        Addy = ""
        Do Until ActiveCell.Row >= Stopper Or (ActiveCell.Value <> "" And ActiveCell.Value <> One(0))
            Addy = Addy & ActiveCell.Offset(0, 2).Value & "|"
            ActiveCell.Offset(1, 0).Select
        One(2) = Trim(Addy)
        All.Add One
        Erase One

    Sheets.Add after:=Sheets(Sheets.Count)

    Cells(1, 1).Select
    For Stopper = 1 To All.Count
        One = All(Stopper)
        ActiveCell.Offset(0, 0).Value = One(0)
        ActiveCell.Offset(0, 1).Value = One(1)
        Addy = Split(One(2), "|")
        If IsArray(Addy) Then
            For L1 = 0 To UBound(Addy)
                ActiveCell.Offset(0, 2 + L1).Value = Addy(L1)
            Next L1
            Erase Addy
            ActiveCell.Offset(0, 2).Value = One(2)
        End If
        ActiveCell.Offset(1, 0).Select
        Erase One
    Next Stopper
End Sub
share|improve this answer
I've tried this, and tried tweaking it a few ways but the end result stays the same. It scans the entire document and then brings over only one name and one number, with no address. Everything else does not seem to be read. – AgainstClint Nov 2 '10 at 13:59
Sorry about that. I have corrected the code. Please give it another try. – Xantec Nov 2 '10 at 14:09
One last thing. I was working on (before you wrote this) on how to get each line of the address to be placed into it's own cell. Pretty much, the person who needs this done will be taking parts from each address for certain things, and they requested it for easier access. Is that possible at all? EDIT: Worst comes to worst, I can delimit them and then merge cells, which I was going to do originally and this made those steps much easier. – AgainstClint Nov 2 '10 at 14:30
Code in the answer edited to output each line of the address into its own cell on the same row – Xantec Nov 2 '10 at 14:49

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.