CODEWITHSUNDEEP
excelvba
Zayd Bhyat
Zayd Bhyat

Reputation: 101

Split Data where no obvious consistent delimiter: Excel - VBA

I'm trying to split my Excel data into various columns. The data I have a acquired is inconsistent, in terms of a delimiter, but there are certain attributes to the data that would help separate them into columns. The problem is, I have limited knowledge in Excel and VBA. Below is a sample from the column I want to split into several columns.

enter image description here

As you can see from the picture above, just using a simple script, which splits the data by a single delimiter, won't work because the addresses can be in a building, a unit or just a single property. However, I did notice that the Suburbs, States and Country are all uppercase. This means there is something I can work with.

So far, all my code does is split the active cell into several cells using a comma delimiter.

Sub SplitColoumn()

    Dim rng As range
    s = Split(ActiveCell, ",")

    Set rng = ActiveCell
    rng.Select

    Set rng = rng.Resize(1, 1 + UBound(s) + 1)
    rng.Select

    rng = s

End Sub

The results are as expected, because all this code will do is split up the active cell, but I can't seem to figure out how to use a loop and have more control of the constraints.

I want to split the addresses into separate columns for Street, Suburb, State and Postcode.

Thanks

EDIT: I have now added the image, I'm not sure why it didn't appear the first time.

Upvotes: 0

Views: 1048

Answers (1)

LocEngineer
LocEngineer

Reputation: 2917

I want to split the addresses into separate columns for Street, Suburb, State and Postcode

I assume you meant separate columns for Street, city, county, country and postcode?

Set a reference to Microsoft VBScript RegularExpression 5.5. Adjust the following code (Range):

Dim rex As RegExp
Dim m As Match, mc As MatchCollection
Dim ran As Range, cel As Range

Set rex = New RegExp
rex.Pattern = "([\w\d\s\,]+?)\,([A-Z\s]+?)\,([A-Z\s]+?)\,([A-Z\s]+?)\,([\d\s]+?)$"

Set ran = Range("A1:A3")

For Each cel In ran
    Set mc = rex.Execute(CStr(cel.Value))
    Set m = mc.Item(0)
    cel = m.SubMatches(0)
    cel.Offset(0, 1) = m.SubMatches(1)
    cel.Offset(0, 2) = m.SubMatches(2)
    cel.Offset(0, 3) = m.SubMatches(3)
    cel.Offset(0, 4) = m.SubMatches(4)
Next cel

This will split the contents of each cell into columns.

Upvotes: 1

Related Questions