I'm trying to put an address list into a document using Excel 2000

**thomasmarc** · 10-07-2011, 06:20 AM

Hi Guys,

I was just wondering if someone could help with this.

I have a list of addresses I’d like to put in an excel spreadsheet document.

I have very little experience of excel formulas.

I’m trying to have find a formula that is able to re-arrange these in the columns I’ve provided.

Please see sample attached.

Hope someone can help with this.

Kind Regards

Marc

**thomasmarc** · 10-25-2011, 11:46 AM

Hi Guys,

Is there anyone out there that can help with this.

Your help is much appreciated.

Thanks

**jaslake** · 10-25-2011, 05:22 PM

Hi Marc

Don't know of a formula that will do as you require. If you're interested in a VBA approach I'd be willing to take a stab at it.

**thomasmarc** · 10-27-2011, 09:29 AM

Hi John,

Yes please if you could give it a stab that would be great.

Thnaks

Marc

**jaslake** · 10-27-2011, 12:07 PM

Hi Marc

This code is in the attached and appears to do as you require. Let me know of issues.

Option Explicit
Sub FindStuff()
    Dim LR As Long
    Dim lCount As Long
    Dim rFoundCell As Range
    Dim sp
    Dim Arr As Variant
    Dim i As Long
    Dim x As Long
    Application.ScreenUpdating = False
    LR = Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row    'find the first available row in column B
    Set rFoundCell = Range("A1")
    For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Tel:*")
        'look for telephone numbers
        Set rFoundCell = Columns(1).Find(What:="Tel:", After:=rFoundCell, _
                LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False)
        With rFoundCell
            sp = Split(rFoundCell, ":")    'split the telephone number
            Range("K" & LR).Value = sp(1)    'place telephone number in column K
            Range("B" & LR).Value = rFoundCell.Offset(-4, 0).Value    'place name in column B
            Arr = Split(rFoundCell.Offset(-1, 0).Value, ",")    'split the address
            x = UBound(Arr)    'find the Post Code
            Range("J" & LR).Value = LTrim(Arr(x))    'put the post code in column J
            For i = LBound(Arr) To UBound(Arr) - 1    ' put the rest of the address in the proper columns
                Range("C" & LR).Offset(0, i) = LTrim(Arr(i))
            Next i
        End With
        LR = Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row    'find the next available row in column B
    Next lCount
    Columns("B:L").AutoFit
    Application.ScreenUpdating = True
End Sub

**thomasmarc** · 10-28-2011, 11:00 AM

Hi John,

Thanks for that, i did post another message but i'm not sure where that went to. The macro is working fine, however i'd like to add more details on the bottom of this. Is there a way you can get the macro to work regardless of the length of the list?

Thanks

Marc

**jaslake** · 10-28-2011, 11:11 AM

Hi Marc

The procedure, as written, should already do that if all records are formatted exactly the same. The procedure looks for "Tel:" in the first column and identifies that as a record. If it finds 10 "Tel:" it'll process 10 records...if it finds 1000 "Tel:" it'll process 1000 records.

If the procedure IS NOT doing that, post the offending file and I'll look at it.