CODEWITHSUNDEEP
excelvba
Khairulanam Abdullah
Khairulanam Abdullah

Reputation: 95

Extract postal code from address using isNumeric

I want to extract postal code from address. I have tried isNumeric method below to extract 6 numeric from the address. Some of the address got 5 digit and some got 6 digit postal code. But there is some error where sometimes 11900 only show 1900, 08000 shows 8000, and 4 digit number also show.

Range("A2").Select
i = 2
Do While ActiveCell <> ""
    Address = UCase(Trim(Range("C" & CStr(i))) + " " + Trim(Range("D" & CStr(i))) + " " + Trim(Range("E" & CStr(i))) + " " + Trim(Range("F" & CStr(i))))

    For p = 1 To Len(Address)
      If IsNumeric(Mid(Address , p, 6)) Then
         Range("O" & CStr(i)) = Mid(Address, p, 6)
      End If
    Next p

    ActiveCell.Offset(1, 0).Select
    i = i + 1
Loop

excel output

Address                                                               Postal Code
Wisma Pansar, 23-27 Jln Bengkel P.O. Box 319, 96007 Sibu Sarawak        96007
Wisma Lim , Lot 50A, Sec. 92A, 3.1/2 Sg Besi, 57100 Kuala Lumpur        57100
No. 265A, Jalan Sungai Petani 08300 Gurun Kedah Darul Aman              8300
No. 39, Jalan Nipah, Taman Lip Sin 11900  Sungai Nibong Pulau Pinang    1900
4-G, Lebuh Sungai Pinang 1 Sri Pinang 11600 Jelutong Pulau Pinang       11600
539/2, Gypsum Metropolitan Tower, Rajthevee Bangkok 10400, Thailand     0400,
LOTS 1869 &1938, 18th MILE KAJANG, SEMENYIH ROAD SELANGOR D.E.          1938, *no postal code in address
36a, Joo Chiat Place, Singapore 427760                                  0

Upvotes: 0

Views: 696

Answers (2)

JvdV
JvdV

Reputation: 75900

To complement @TimWilliams his answer, hereby a solution making use of Array and Regular Expressions (with late binding). So let's immagine the following setup:

enter image description here

Now run the following code:

Sub Test()

Dim lr As Long, x As Long
Dim arr As Variant
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.regexp")

'Set up regular expression
RegEx.Pattern = "\d{5,6}"
RegEx.Global = True

'Go through your data and execute RegEx
With Sheet1 'Change according to your sheets CodeName
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:A" & lr).Value
    .Range("B2:B" & lr).NumberFormat = "@"
    For x = LBound(arr) To UBound(arr)
        Set Matches = RegEx.Execute(arr(x, 1))
        For Each Match In Matches
            .Cells(x + 1, 2) = Match.Value
        Next Match
    Next x
End With

End Sub

enter image description here

Assuming the possibility of multiple matches within a string, the last match will be used.

If you are sure there can only be one match (or none), then you could also use:

If Matches.Count = 1 Then .Cells(x + 1, 2) = Matches.Item(0)

Instead of:

For Each Match In Matches
    .Cells(x + 1, 2) = Match.Value
Next Match

Upvotes: 1

Tim Williams
Tim Williams

Reputation: 166511

I mean something like this:

Sub test()
    Dim c As Range, p As Long, v, addr, i As Long, hit As Boolean

    Set c = Range("A2") 'no need to select the cell
    Do While c <> ""
        addr = c.Value 'using your examples
        hit = False
        For p = 1 To Len(addr)
            'will accept 5 or 6 digits - prefer 6
            ' so count down...
            For i = 6 To 5 Step -1
                v = Mid(addr, p, i)
                If v Like String(i, "#") Then
                    c.Offset(0, 1).NumberFormat = "@" 'in case of leading zero
                    c.Offset(0, 1).Value = v
                    hit = True
                    Exit For
                End If
            Next i
            If hit Then Exit For
        Next p
        Set c = c.Offset(1, 0)
    Loop
End Sub

enter image description here

A regular expression approach would probably be much nicer.

Upvotes: 2

Related Questions