Extract Address and phone numbers

Originally Posted by Mallycat

How would I now which data belongs to which record?
Plus I can see a lot more than 4 fields

As you can see below, its just raw data then there is some data that meaningful like the name, address, city state zip (all in column A) and then phone number

I have a word macro that does that job of taking the record out, since I can do a search in the area code prefix, e.g. Look for Open parenthesis then look for any text inside the parenthesis an then any text and then any text and then close parenthesis and that fixes the location to the area code and once the area code is detected I will select that line and up 3 more and cut it out and page in a new word document. But the process is TOO SLOW.

In excel it might look for the area code and work up 3 rows and put that data across the column in one row but multiple columns in a format like

name, adress, city state zip, phone number

Any help would be appreciated.

thanks



The data just flow like this
garbage
garbage
garbage
garbage
garbage
garbage
james smith
123 abc street
new york, ny, 12345
(212) 555-5555
garbage
garbage
garbage
garbage
garbage
james woo
456 abc street
new york, ny, 12345
(213) 555-5555
garbage
garbage

Hello ,

This macro will copy the address fields to single a row in columns "B:E" of the active sheet. The macro assumes the following conditions:

1. Data is in column "A" and starts at cell A2 with a header in A1.
2. The address is always 4 lines with the telephone number in the last line.
3. Telephone numbers do not start with the long distance prefix "1-".
4. Valid separators in a telephone number are a single space or hyphen.
5. Area code is optional. Parentheses around the area code are also optional.

Sub ListAddresses()

  Dim Data() As Variant
  Dim I As Long
  Dim RegExp As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    
    Set Rng = Wks.Range("A2")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
    
    ReDim Data(1 To Rng.Rows.Count, 1 To 1)
    Data = Rng.Value
    
   'Create a Regular Expression for pattern matching
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.IgnoreCase = True
    
   'Valid telephone number pattern
    RegExp.Pattern = "^(\(\d{3}\)|\d{3})?[-\s]?\d{3}[-\s]?\d{4}"
    
     'Test if data is telephone number
      For I = 1 To UBound(Data)
        If RegExp.Test(Data(I, 1)) Then
         'Copy the address fields to a single row in columns B:E
          Rng.Cells(I - 3, 2).Resize(1, 4) = WorksheetFunction.Transpose(Rng.Cells(I - 3, 1).Resize(4, 1))
        End If
      Next I
      
   'Release the object reference and memory
    Set RegExp = Nothing
    
End Sub

Adding the Macro
1. Copy the macro above pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
7. Make any custom changes to the macro if needed at this time.
8. Save the Macro by pressing the keys CTRL+S
9. Press the keys ALT+Q to exit the Editor, and return to Excel.

To Run the Macro...
To run the macro from Excel, open the workbook, and press ALT+F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.