Can this UK Postcode Lookup be converted from Access to Work with Excel

V

vandango05

Board Regular
Joined
Oct 6, 2008
Messages
110
I've found some code that looksup online UK postcodes and returns all matching addresses in an Access Form.

I wonder if it's possible to do something similar in Excel? Here is the example code from Access:

Code: 
Option Compare Database

'Requires reference to WinHTTP.dll This can be found in 'C:\Windows\System32\'


Private Sub Text0_AfterUpdate()


    Me.List2.RowSource = ""
    Dim Pcode, sStr As String
    'First up, Format the postcode
    Pcode = UCase(Replace(Text0, " ", ""))
    Select Case Len(Pcode)
        Case 5
            Pcode = Mid(Pcode, 1, 2) & " " & Mid(Pcode, 3, 3)
        Case 6
            Pcode = Mid(Pcode, 1, 3) & " " & Mid(Pcode, 4, 3)
        Case 7
            Pcode = Mid(Pcode, 1, 4) & " " & Mid(Pcode, 5, 3)
    End Select
    
    'Now create the search string
    'http://www.192.com/places/ab/ab10-1/ab10-1an/
    sStr = "http://www.192.com/places/"
    For a = 1 To Len(Pcode)
        If IsNumeric(Mid(Pcode, a, 1)) Then
            sStr = sStr & Mid(Pcode, 1, a - 1) & "/"
            a = Len(Pcode)
        End If
    Next a
    sStr = sStr & Mid(Replace(Pcode, " ", "-"), 1, InStr(Pcode, " ") + 1) & "/"
    sStr = sStr & Replace(Pcode, " ", "-") & "/"
    
    'Now I create a WinHTTP request to get the information from the server
    
    Dim winReq As WinHttpRequest
    Dim HTM, Address As Variant
    Dim Add1, Add2, Add3, Add4 As String
    Dim sCount As Integer
    
    Set winReq = New WinHttpRequest
    With winReq
        .Open "GET", sStr, False
        .Send
        HTM = Split(Replace(.ResponseText, """", "'"), "<")
        If .Status <> 200 Then
            MsgBox ("Address not found")
            Exit Sub
        End If
    End With
    
    'Now I have the entire web page including tags just without the '<' at the beginning of each line
    'Split this down to find the address lines
    For Each i In HTM
        If InStr(i, "td class='address'>") > 0 Then
            'You can the assign the address to a listbox as below
            Me.List2.AddItem (Replace(i, "td class='address'>", ""))
            
            'Or you can split the address in to variables
            Address = Split((Replace(i, "td class='address'>", "")), ",")
            sCount = 0
            For Each j In Address
                sCount = sCount + 1
            Next
            Select Case sCount
                Case 3
                    Add1 = Address(0)
                    Add4 = Address(1)
                Case 4
                    Add1 = Address(0)
                    Add3 = Address(1)
                    Add4 = Address(2)
                Case 5
                    Add1 = Address(0)
                    Add2 = Address(1)
                    Add3 = Address(2)
                    Add4 = Address(3)
                Case 6
                    Add1 = Address(0) & " " & Address(1)
                    Add2 = Address(2)
                    Add3 = Address(3)
                    Add4 = Address(4)
            End Select
            'Put code here to assign these variables to anything you like
            
        End If
    Next
    
End Sub

Ideally a postcode could be entered in a specific cell then data fills into the cells below.

I've been searching forums and haven't found anything, wonder if anyone could help?
 
Sort by date Sort by votes
Perfect, thank you. I have discovered the problem.

I didn't have a declaration at the top - Option Explicit

Final question, I promise!

Would it be possible to split the address into different cells; Street, Town, City, Country etc?

I'm sure this function would be very useful to many users :)

Thanks again Andrew.
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
I don't see how the absence of Option Explicit would affect the function.

If you change the code slightly:

Rich (BB code): 
                Case 4
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2)
                Case 5
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2) & ";" & Address(3)
                Case 6
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2) & ";" & Address(3) & ";" & Address(4)

you can use Data|Text To Columns with the semicolon as the separator to parse the address. It would be possible to amend the function to return an array, but that would make entering the formula more difficult.
 
Upvote 0
Thank you for your help with this yesterday Andrew, it works extremely well until I get to business postcodes such as BR2 8GP.

I've gone back to the original code and added in for a business search but i'm getting the result in Excel of 0.

Would you be so kind to take a look for me?

Code: 
Option Explicit

Function GetAddress(Postcode As String)
'   Requires reference to Microsoft WinHTTP Services
    Dim sStr As String
    Dim a As Long
    Dim winReq As WinHttpRequest
    Dim HTM As Variant, Address As Variant
    Dim i As Variant
    Dim j As Variant
    Dim sCount As Integer
    Dim Biz As Boolean
    Dim BizName, BizAddr As String
    
   
    
'   First up, Format the postcode
    Select Case Len(Postcode)
        Case 5
            Postcode = Mid(Postcode, 1, 2) & " " & Mid(Postcode, 3, 3)
        Case 6
            Postcode = Mid(Postcode, 1, 3) & " " & Mid(Postcode, 4, 3)
        Case 7
            Postcode = Mid(Postcode, 1, 4) & " " & Mid(Postcode, 5, 3)
    End Select
'   Now create the search string
    sStr = "http://www.192.com/places/"
    For a = 1 To Len(Postcode)
        If IsNumeric(Mid(Postcode, a, 1)) Then
            sStr = sStr & Mid(Postcode, 1, a - 1) & "/"
            a = Len(Postcode)
        End If
    Next a
    sStr = sStr & Mid(Replace(Postcode, " ", "-"), 1, InStr(Postcode, " ") + 1) & "/"
    sStr = sStr & Replace(Postcode, " ", "-") & "/"
'   Now I create a WinHTTP request to get the information from the server


Biz = 0
    Set winReq = New WinHttpRequest
    With winReq
        .Open "GET", sStr, False
        .Send
        HTM = Split(Replace(.ResponseText, """", "'"), "<")
        If .Status <> 200 Then
            GetAddress = "Address not found"
            Exit Function
        End If
    End With
'   Now I have the entire web page including tags just without the '<' at the beginning of each line
'   Split this down to find the address lines
    For Each i In HTM
        If InStr(i, "td class='address'>") > 0 Then
'           Split the address in to variables






            Address = Split((Replace(i, "td class='address'>", "")), ",")
            sCount = 0
            For Each j In Address
                sCount = sCount + 1
            Next
            Select Case sCount
                Case 3
                    GetAddress = Address(0) & ";" & Address(1)
                Case 4
                    GetAddress = Address(0) & ";" & Address(1) & ";" & Address(2)
                Case 5
                    GetAddress = Address(0) & ";" & Address(1) & ";" & Address(2) & ";" & Address(3)
                Case 6
                    GetAddress = Address(0) & ";" & Address(1) & ";" & Address(2) & ";" & Address(3) & ";" & Address(4)
                
            End Select
        End If
  
    'for businesses
    
    If InStr(i, "div class='businessInfo'>") > 0 Then
            Biz = -1
        End If
        If Biz = -1 And Left(i, 13) = "a href='/atoz" Then
            BizName = GetStringPartR(i, ">") & ", "
            Biz = 0
        End If
        
        If Left(i, 20) = "span class='address'" Then
            BizAddr = Mid(i, 22 + 11, Len(i) - 21)
            BizAddr = BizName & BizAddr
                                   
        End If
           Next i


    
End Function




Private Function GetStringPartR(ByVal xStr As String, xChar As Variant)
Dim i, x, ln As Integer


ln = Len(xStr)


For i = 0 To Len(xStr)
x = Mid(xStr, ln - i, 1)


If x = xChar Then
    GetStringPartR = Right(xStr, i)
    Exit Function
End If


Next i


End Function
 
Upvote 0
I haven't made any significant changes to the code you posted. Is there some other procedure for businesses in the Access form?
 
Upvote 0
No there are only the two procedures, my previous post included the Access database if you wanted to compare?
 
Upvote 0
You didn't include the business section of the code in your original post. Try:

Rich (BB code): 
Function GetAddress(Postcode As String)
'   Requires reference to Microsoft WinHTTP Services
    Dim sStr As String
    Dim a As Long
    Dim winReq As WinHttpRequest
    Dim HTM As Variant, Address As Variant
    Dim i As Variant
    Dim j As Variant
    Dim sCount As Integer
    Dim Biz As Long
    Dim BizName As String
    Dim BizAddr As String
'   First up, Format the postcode
    Select Case Len(Postcode)
        Case 5
            Postcode = Mid(Postcode, 1, 2) & " " & Mid(Postcode, 3, 3)
        Case 6
            Postcode = Mid(Postcode, 1, 3) & " " & Mid(Postcode, 4, 3)
        Case 7
            Postcode = Mid(Postcode, 1, 4) & " " & Mid(Postcode, 5, 3)
    End Select
'   Now create the search string
    sStr = "Places and Addresses - Maps and Aerial Photos - 192.com"
    For a = 1 To Len(Postcode)
        If IsNumeric(Mid(Postcode, a, 1)) Then
            sStr = sStr & Mid(Postcode, 1, a - 1) & "/"
            a = Len(Postcode)
        End If
    Next a
    sStr = sStr & Mid(Replace(Postcode, " ", "-"), 1, InStr(Postcode, " ") + 1) & "/"
    sStr = sStr & Replace(Postcode, " ", "-") & "/"
'   Now I create a WinHTTP request to get the information from the server
    Set winReq = New WinHttpRequest
    With winReq
        .Open "GET", sStr, False
        .Send
        HTM = Split(Replace(.ResponseText, """", "'"), "<")
        If .Status <> 200 Then
            GetAddress = "Address not found"
            Exit Function
        End If
    End With
'   Now I have the entire web page including tags just without the '<' at the beginning of each line
'   Split this down to find the address lines
    For Each i In HTM
        If InStr(i, "td class='address'>") > 0 Then
'           Split the address in to variables
            Address = Split((Replace(i, "td class='address'>", "")), ",")
            sCount = 0
            For Each j In Address
                sCount = sCount + 1
            Next
            Select Case sCount
                Case 3
                    GetAddress = Address(0) & " " & Address(1)
                Case 4
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2)
                Case 5
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2) & ";" & Address(3)
                Case 6
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2) & ";" & Address(3) & ";" & Address(4)
            End Select
        End If
'       For businesses
        If InStr(i, "div class='businessInfo'>") > 0 Then
            Biz = -1
        End If
        If Biz = -1 And Left(i, 13) = "a href='/atoz" Then
            BizName = GetStringPartR(i, ">") & ", "
            Biz = 0
        End If
        If Left(i, 20) = "span class='address'" Then
            BizAddr = Mid(i, 22 + 11, Len(i) - 21)
            BizAddr = BizName & BizAddr
            GetAddress = BizAddr
            Exit Function
        End If
    Next i
End Function

Private Function GetStringPartR(ByVal xStr As String, xChar As Variant)
    Dim ln As Long, i As Long, x As String
    ln = Len(xStr)
    For i = 0 To Len(xStr)
        x = Mid(xStr, ln - i, 1)
        If x = xChar Then
            GetStringPartR = Right(xStr, i)
            Exit Function
        End If
    Next i
End Function
 
Upvote 0
You didn't include the business section of the code in your original post. Try:

Rich (BB code): 
Function GetAddress(Postcode As String)
'   Requires reference to Microsoft WinHTTP Services
    Dim sStr As String
    Dim a As Long
    Dim winReq As WinHttpRequest
    Dim HTM As Variant, Address As Variant
    Dim i As Variant
    Dim j As Variant
    Dim sCount As Integer
    Dim Biz As Long
    Dim BizName As String
    Dim BizAddr As String
'   First up, Format the postcode
    Select Case Len(Postcode)
        Case 5
            Postcode = Mid(Postcode, 1, 2) & " " & Mid(Postcode, 3, 3)
        Case 6
            Postcode = Mid(Postcode, 1, 3) & " " & Mid(Postcode, 4, 3)
        Case 7
            Postcode = Mid(Postcode, 1, 4) & " " & Mid(Postcode, 5, 3)
    End Select
'   Now create the search string
    sStr = "Places and Addresses - Maps and Aerial Photos - 192.com"
    For a = 1 To Len(Postcode)
        If IsNumeric(Mid(Postcode, a, 1)) Then
            sStr = sStr & Mid(Postcode, 1, a - 1) & "/"
            a = Len(Postcode)
        End If
    Next a
    sStr = sStr & Mid(Replace(Postcode, " ", "-"), 1, InStr(Postcode, " ") + 1) & "/"
    sStr = sStr & Replace(Postcode, " ", "-") & "/"
'   Now I create a WinHTTP request to get the information from the server
    Set winReq = New WinHttpRequest
    With winReq
        .Open "GET", sStr, False
        .Send
        HTM = Split(Replace(.ResponseText, """", "'"), "<")
        If .Status <> 200 Then
            GetAddress = "Address not found"
            Exit Function
        End If
    End With
'   Now I have the entire web page including tags just without the '<' at the beginning of each line
'   Split this down to find the address lines
    For Each i In HTM
        If InStr(i, "td class='address'>") > 0 Then
'           Split the address in to variables
            Address = Split((Replace(i, "td class='address'>", "")), ",")
            sCount = 0
            For Each j In Address
                sCount = sCount + 1
            Next
            Select Case sCount
                Case 3
                    GetAddress = Address(0) & " " & Address(1)
                Case 4
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2)
                Case 5
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2) & ";" & Address(3)
                Case 6
                    GetAddress = Address(0) & " " & Address(1) & ";" & Address(2) & ";" & Address(3) & ";" & Address(4)
            End Select
        End If
'       For businesses
        If InStr(i, "div class='businessInfo'>") > 0 Then
            Biz = -1
        End If
        If Biz = -1 And Left(i, 13) = "a href='/atoz" Then
            BizName = GetStringPartR(i, ">") & ", "
            Biz = 0
        End If
        If Left(i, 20) = "span class='address'" Then
            BizAddr = Mid(i, 22 + 11, Len(i) - 21)
            BizAddr = BizName & BizAddr
            GetAddress = BizAddr
            Exit Function
        End If
    Next i
End Function

Private Function GetStringPartR(ByVal xStr As String, xChar As Variant)
    Dim ln As Long, i As Long, x As String
    ln = Len(xStr)
    For i = 0 To Len(xStr)
        x = Mid(xStr, ln - i, 1)
        If x = xChar Then
            GetStringPartR = Right(xStr, i)
            Exit Function
        End If
    Next i
End Function
 
Upvote 0
My original post didn't include it, but today's did after I tried to add it. Sorry, for not making this clear.

I'm getting #VALUE like I did yesterday now, would you be so kind to re-upload the sheet if it works for you?
 
Upvote 0
You must log in or register to reply here.

Similar threads

ChristineJ
  • Solved
Change hard coded cell references to variables in code
Replies
4
Views
807
Peter_SSs
Peter_SSs
H
  • Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
2K
HeinrichPaul
H
J
  • Question
Scraping data from WIFI networks that are available
9 10 11
Replies
109
Views
5K
Prome3
P
J
  • Locked
  • Question
Vlookup from multiselect data validation list
Replies
2
Views
774
Peter_SSs
Peter_SSs
D
  • Question
VBA for converting numbers to text in a alphanumeric value
Replies
4
Views
2K
swapnilk
S

Forum statistics

Threads
1,215,636
Messages
6,125,952
Members
449,276
Latest member
surendra75

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top