Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

moving data from rows to colums

moving data from rows to colums

moving data from rows to colums

An Excel Spreadsheet Question
              A                                                                     B                           C
 1     Joes  Market  865-123-2345
 2     123 Willow Way
 3     Knoxville, TN
 5     Bills Deli  865-234-3456
 6     234 Fox Run
 7     Knoxville, TN


 The first cells contents is a text string followed by a phone number.  The phone number will always be xxx-xxx-xxxx  (area code, and then the number).  What would I have to do to create a macro to move the phone number only, out of the cell, to the next cell over...  (text and phone number in A1)  leaving text in A1 and moving
phone number to B1. Then I want to move what is in A2 to C1, A3 to  D1.  Then repeat the process with the next address.  I have a list of over 2000 addresses in Column A in a spread sheet.   


RE: moving data from rows to colums

You need a For loop incrementing a row counter by Step 4. (I'm assuming all the addresses take exactly 4 rows.) Within the loop, use Cells(row+0,1) to access the value in the first row of the address, Cells(row+1,1) for the second row, etc. Move the value to Cells(row,2) for the phone number, Cells(row,3) for the address, etc.

The name/phone number takes a little extra work. You'll have to use another For loop with another counter variable to loop through the characters in the value. First copy Cells(row,1) to a string variable. Then use Mid$(<stringvar>,i,1) to get each character. When you find a digit, copy Mid$(<stringvar>,i) to Cells(row,2). That puts the phone number in column B. Then move Left$(<stringvar>,i-1) to Cells(row,1). That puts just the name in column A. Note: Since you're modifying existing data, it would be wise to save a copy of your workbook before you run this macro.

After you've written the code and gotten it working, you'll want to delete the 2nd, 3rd, and 4th rows for each address. You can write a macro to do this, too, but make sure your For loop counts downward from the bottom to the top of the sheet. The reason is that if you count upward, as soon as you delete row 2, what started out as row 3 becomes row 2. So then, when you delete row 3, it's really what started out as row 4, and when you delete row 4 it's what started out as row 6. If you count downward, the rows that change number with each row deletion will all be lower in the sheet, and since you're working upward in the sheet they won't bother you.

Rick Sprague

RE: moving data from rows to colums

Rick, thanks for your help.
I am a "newbie" at this though.... I tried going through the VBA help, and really didn't know where to start.  Actually, what I'm wanting to do is import these addresses into a database, and to also create mailing labels.  I have fax numbers to add, as well as contacts, and zip codes.  I've been copying these addresses off the net, (Copy / Paste, so I thought maybe the first step was to do what I wanted to do in my post, so I could import it.  Is there a different, or better way?  Thanks.


RE: moving data from rows to colums

If you wanted to end up in a database, you'd have been a lot better off starting in a database, really.

I've written the code for you. This makes heavy use of the Excel object model, which is the foundation of VBA programming in Excel. Learning VBA isn't exactly something you can do in an afternoon, but it's well worth it, because some things simply can't be done with recorded macros.

The code below makes the following assumptions:
1. Every address consists of exactly 3 rows.
2. There is exactly one row between addresses.
3. The first row of an address contains a name,
   optionally followed by a phone number. The phone
   number consists of digits and hyphens only.
4. The second row of an address contains an optional
   street address.
5. The third row of an address contains an optional
   city, state, and zip or postal code.
6. The first row following the last address is blank.

You should, of course, back up your workbook before testing this or any macro.

In your Excel workbook, choose Tools>Macros>VBA Editor. This will open a separate application, the VBA Editor. In the Editor, a window titled Module1 should be displayed. If not, choose Insert>Module from the menu. Paste the following code into the module window:

Sub FixAddress()
    Const StartPos = "A1"    ' change to the first name cell
    Dim strName As String
    Dim strPhone As String
    Dim i As Long
    Dim blnFoundPhone As Boolean

    ' Position to the start of the addresses
    ' Loop through each address
        ' Stop when end of list is reached
        If ActiveCell.Formula = "" Then Exit Do
        ' Get the Name cell value
        strName = ActiveCell.Formula
        ' Scan from right to left, looking for phone number
        i = Len(strName)
        blnFoundPhone = True
        Do While Mid$(strName, i, 1) <> " "
            Select Case Mid$(strName, i, 1)
                Case "0" To "9", "-"
                    i = i - 1
                Case Else
                    blnFoundPhone = False
                    Exit Do
            End Select
        ' If phone number found, move it to column B
        If blnFoundPhone Then
            ActiveCell.Offset(0, 1).Formula = Mid$(strName, i + 1)
            ActiveCell.Formula = Left$(strName, i - 1)
        End If
        ' Move remaining rows to columns C, D
        ActiveCell.Offset(0, 2).Formula = ActiveCell.Offset(1, 0).Formula
        ActiveCell.Offset(0, 3).Formula = ActiveCell.Offset(2, 0).Formula
        ' Delete the next 3 rows
        ActiveCell.Offset(1, 0).Resize(3, 1).EntireRow.Delete
        ' Move down one row
        ActiveCell.Offset(1, 0).Select
    ' Return to top
End Sub

Modify the "StartPos" constant near the top to the cell address where the first name appears.

Now return to the Excel workbook and run the FixAddress macro. That should do it.

Rick Sprague

RE: moving data from rows to colums

Thanks for your input Rick. I loaded the code...and the columns moved, and the rows deleted, but the phone number didn't move. I'll look through it and see if its a small change though. Thanks again !  


Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close