moving data from rows to colums 1

[pcaok]

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

etc.....

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.

Thanks

 

[RickSpr]

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

 

[pcaok]

Rick, thanks for your help.
I am a &quot;newbie&quot; 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.

Brian

 

[RickSpr]

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
    ActiveSheet.Range(StartPos).Select
    ' Loop through each address
    Do
        ' 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) <> &quot; &quot;
            Select Case Mid$(strName, i, 1)
                Case &quot;0&quot; To &quot;9&quot;, &quot;-&quot;
                    i = i - 1
                Case Else
                    blnFoundPhone = False
                    Exit Do
            End Select
        Loop
        ' 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
    Loop
    ' Return to top
    ActiveSheet.Range(StartPos).Select
End Sub

Modify the &quot;StartPos&quot; 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

 

[pcaok]

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 !