Excel Problem - Need help Dividing Data from 1 column into many columns

[Charles101]

Hi
I am working on an excel doc with all the data in 1 column(sample data below)
I need to divide the data into numerous colmns ( last name, name, address, code, tel # )
what is the best approach to help me with this
I am new with excel but I am a very quick learner

Thanks


I want my data to look like this

last name	Name	Address	Code	Tel #
STEIN	Aryeh	254 Kolel Rd	MS	242-2069

<tbody>
</tbody>

Data in 1 column
STEIN Aryeh 254 Kolel Rd MS.........................................242-2069 STEIN Barry.....................................................401-0069 TANNENBAUM Mayer 45 Ashel Ln sv......................426-2852 TAUB Shmiel Duvid 125 PI, Andre Ouellet.................................434-5656 TEMPLER Joseph 75 Bluefield Drsv..................................356-1568 TEVEL Pinchas 42 Youmans Dr sv...................................................352-7223 TOKAY REALTY CORP 56 Union Rd #203A sv.......... 290-9944 TRIEGER Yoel 93 Highview Rd SF...........................369-3074 TURIM Avrum Chaim 4 Homestead Ln #203 MS....... 354-2636 TWERSKY David 125 Kaser Terr MS................................425-9874 UNGAR Mordechai 1852 Park View Dr sv.....................................371-5112 WASSERMAN Josef 9 Crest Ct #303 ms............................356-0756 WEINBERG Moshe 262 Rock Hill Rd sv.......................... 371-7778 WEINREB Aryeh 31 Mariner Way MS.............................................362-8415 WEINREB Bernard 48 Brockton Rd sv.............................................354-4999 WEINSTOCK Aron 26 Adar Ct ms................................352-8125 WEISS Mayer 1555 Taft Ln............................................354-2253 WERTZBERGER Chaim Eluzer 85 Yoel Klein Blvd #301.. 783-1752 WERTZBERGER Wolf Duvid 75 Kalev Way #201 782-8757 YESHIVA SHAAR EPHRAIM 42 Acer Ct ms..................... 426-6425 <tbody> </tbody>

<tbody>
</tbody>

 

[pbornemeier]

Your problem is harder than it appears due to the lack of uniformity that is possible in an address. The following code will get most of the the data extractions correct for the given examples, but you will still have to review the result and ensure it is correct. More variance in other input addresses may cause other errors.

Option Explicit

Sub ParseList()
    
    Dim lLastRow As Long
    Dim lX As Long, lY As Long
    Dim sInput As String
    Dim lLength As Long
    Dim lValue As Long
    Dim lDotDotPosition As Long
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    'Duplicate to column B
    Columns("A:A").Copy Destination:=Range("B1")
    
    'Assume no spaces in last name.
    'Everything left of first space is last name.
    'Put it into column C
    With Range(Cells(1, 3), Cells(lLastRow, 3))
        .FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1])-1)"
        .Value = .Value
    End With
    'Remainder after space after last name to column D
    With Range(Cells(1, 4), Cells(lLastRow, 4))
        .FormulaR1C1 = "=MID(RC[-2],FIND("" "",RC[-2])+1,1000)"
        .Value = .Value
    End With
    
    
    'G is last 8 characters of B
    For lX = 1 To lLastRow
        sInput = Cells(lX, 4).Value
        lLength = Len(sInput)
        'Assume all addresses start with a number
        For lY = 1 To lLength
            lValue = Asc(Mid(sInput, lY, 1))
            If lValue > 47 And lValue < 58 Then Exit For
        Next
        'Name is all left of first number in column D
        Cells(lX, 5).Value = Trim(Left(sInput, lY - 1)) 'Name to column E
        Cells(lX, 6).Value = Trim(Mid(sInput, lY))      'Remainder to Column F
        
        'Edit F to get rid of everything after first ".." sequence
        lDotDotPosition = InStr(Cells(lX, 6).Value, "..")
        If lDotDotPosition > 0 Then Cells(lX, 6).Value = Left(Cells(lX, 6).Value, lDotDotPosition - 1)
        
        'Phone is last 8 characters of column B.  Phone to G
        Cells(lX, 7).Value = Right(Trim(Cells(lX, 2).Value), 8)
    Next
    
    'Now delete intermediate columns & resize to fit
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("B:B").Delete Shift:=xlToLeft
    Cells.EntireColumn.AutoFit
    
End Sub