Need a Clickable link to a website - URL changes

[Swarmo]

Hello,
I'm new here and glad to be part of this community.

This is what I am trying to achieve. Any help would be hugely appreciated.

I want to visually validate a number that has been entered into the spreadsheet (This number is an Australian Business Number)
My plan is to enter the Australian Business Number into the spreadsheet, then simply click a button to load up the Australian Business Number lookup website.
The website will show me if the ABN I entered is actually valid. I will simply look at the website, match the ABN with the customer's business name, then close the webpage.

To do this, I have an idea, but I need some help.

I have downloaded a certain picture. It is a picture of a magnifying glass. I would like this magnifying glass to be clickable.
It will link the user to the ABN Lookup website, which will have the search string added.

The link I made below works. But I want to somehow add that link to the magnifying glass picture somehow.
I want the link to update the search text dependent on the Australian Business Number entered into the spreadsheet

=HYPERLINK("http://abr.business.gov.au/SearchByAbn.aspx?SearchText="&R2)

I would be so grateful for any assistance or guidance.

[AB33]

I am not sure I completely understood your request. It would be easier if you could attach an excel sample book (Not a picture) with the ABN no listed on column A and what you want from the site on column B. To attach a sample, click the Go Advanced Tab- then on the middle of the page, you can see "Manage attachment"

I tested the following number: 83 106 657 309 and got the following data from a table.


Entity name: RIAL INTERNATIONAL PTY. LTD.
ABN status: Active from 13 Oct 2003
Entity type: Australian Private Company
Goods & Services Tax (GST): Not currently registered for GST
Main business location: VIC 3124

[PFDave]

Please Login or Register  to view this content.

Will do it - then Assign the Macro to your image

[Swarmo]

Thank you PFDave, you're a champion! That worked exactly how I needed it. I just needed to add PtrSafe before Function so it would work with my 64 bit software

AB33, thanks for your post. Do either of you gentlemen think that it's possible to import data from the website tables to help me validate the information without opening a web browser?

I have attached a sample book showing how it might work.

Thanks again, I truly appreciate your help.

[Marc L]

Hi !

A demonstration for ABN in D1 cell :

Sub Demo1()
        Dim oDoc As Object, R&, T%
        Set oDoc = CreateObject("HTMLfile")
        Range("C1", Cells(Rows.Count, 4).End(xlUp)).Offset(1).Clear
With CreateObject("MSXML2.XMLHttp")
    .Open "GET", "http://abr.business.gov.au/SearchByAbn.aspx?SearchText=" & [D1].Value, False
    .setRequestHeader "DNT", "1"
        On Error Resume Next
    .send
        On Error GoTo 0
    If .Status = 200 Then
             oDoc.body.innerHTML = .responseText
        With oDoc.getElementsByTagName("TABLE")
            For T = 0 To Application.Min(.Length - 1, 2)
                If oDoc.frames.clipboardData.setData("Text", .Item(T).outerHTML) Then
                    R = Cells(Rows.Count, 3).End(xlUp).Row + 1
                    ActiveSheet.Paste Cells(R, 3)
                    Cells(R, 3).Resize(, 2).Clear
                    If Cells(R + 1, 3).Value = "Trading name" Then Exit For
                End If
            Next
        End With
    End If
End With
If R Then
                   oDoc.frames.clipboardData.clearData "Text"
    With Range("C1", Cells(Rows.Count, 4).End(xlUp))
        .Hyperlinks.Delete
        .WrapText = False
        .Columns.AutoFit
    End With
End If
        Set oDoc = Nothing
End Sub 

Do you like it ? So thanks to click on bottom left star icon « Add Reputation » !

[Swarmo]

Wow, that is absolutely phenomenal!

How do I commend you or add a reputation? Fantastic work. Thanks so much.

[Marc L]

Thanks for the rep' !

A must see : Web Scraping tutorial …

[Swarmo]

Hi Marc L,
Thanks for the link, I will spend some time studying it.

I have just come across an error. If you have the time to help, I'd really appreciate it.

It seems some business's have different results on the ABN lookup website.

When I input ABN 72147972147, that business' ABN doesn't have a business name or trading name. If I click my button a second time it makes the table go down and not refresh in the same spot. It is also generating an invisible Hyperlink. I really wish I could trouble shoot this, but I just don't understand it yet.

If I knew how to edit the code you gave me, I would make it so it looks up only the information below. It seems every business has that information stored, so it won't malfunction in the future.

Entity name: LUMEX PTY LTD
ABN status: Active from 21 Dec 2010
Entity type: Australian Private Company
Goods & Services Tax (GST): Not currently registered for GST
Main business location: VIC 3803

Thanks for your time

[Marc L]

For ABN 72147972147, it's only an EXCEL basics issue !

Sub Demo2()
        Dim oDoc As Object, R&, T%
        Set oDoc = CreateObject("HTMLfile")
        Range("C1", Cells(Rows.Count, 3).End(xlUp)).Resize(, 2).Offset(1).Clear
With CreateObject("MSXML2.XMLHttp")
    .Open "GET", "http://abr.business.gov.au/SearchByAbn.aspx?SearchText=" & [D1].Value, False
    .setRequestHeader "DNT", "1"
        On Error Resume Next
    .send
        On Error GoTo 0
    If .Status = 200 Then
             oDoc.body.innerHTML = .responseText
        With oDoc.getElementsByTagName("TABLE")
            For T = 0 To Application.Min(.Length - 1, 2)
                If oDoc.frames.clipboardData.setData("Text", .Item(T).outerHTML) Then
                    R = Cells(Rows.Count, 3).End(xlUp).Row + 1
                    ActiveSheet.Paste Cells(R, 3)
                    Cells(R, 3).Resize(, 2).Clear
                    If Cells(R + 1, 3).Value = "Trading name" Then Exit For
                End If
            Next
        End With
    End If
End With
If R Then
                   oDoc.frames.clipboardData.clearData "Text"
    With Range("C1", Cells(Rows.Count, 3).End(xlUp)).Resize(, 2)
        .Hyperlinks.Delete
        .WrapText = False
        .Columns.AutoFit
    End With
End If
        Set oDoc = Nothing
End Sub 

[Swarmo]

Thank you so much. That fixed it.

I will study this now, I need to understand how it works.

Thanks again

[Marc L]

Previous code was just to show you issue was on Excel side and at beginner level as it was just a range clear !

According to the 3 ABN codes, loading only desired tables is not difficult :

Sub Demo3()
        Dim oDoc As Object, R&, T%, V, W
        Range("C1", Cells(Rows.Count, 3).End(xlUp)).Resize(, 2).Offset(1).Clear
With CreateObject("MSXML2.XMLHttp")
    .Open "GET", "http://abr.business.gov.au/SearchByAbn.aspx?SearchText=" & [D1].Value, False
    .setRequestHeader "DNT", "1"
        On Error Resume Next
    .send
        On Error GoTo 0
    If .Status = 200 Then
        Set oDoc = CreateObject("HTMLfile")
            oDoc.body.innerHTML = .responseText
    End If
End With
     If Not oDoc Is Nothing Then
                    W = [{"Entity name:","Business name","Trading name"}]
       With oDoc.getElementsByTagName("TABLE")
            Do
                    V = Application.Match(.Item(T).Cells(0).innerText, W, 0)
             If IsNumeric(V) Then
                If oDoc.frames.clipboardData.setData("Text", .Item(T).outerHTML) Then
                    R = Cells(Rows.Count, 3).End(xlUp).Row + 1
                    ActiveSheet.Paste Cells(R, 3)
                    Cells(R, 3).Resize(, 2).Clear
                End If
                    If V = 3 Then Exit Do
             End If
                       T = T + 1
            Loop While T < .Length
       End With
       If R Then
                   oDoc.frames.clipboardData.clearData "Text"
            With Range("C3", Cells(Rows.Count, 3).End(xlUp)).Resize(, 2)
                .Hyperlinks.Delete
                .WrapText = False
                .Columns.AutoFit
            End With
       End If
        Set oDoc = Nothing
     End If
End Sub 

You like it ? So thanks to …