VBA for lookup process

Stig1dre

New Member
Joined
Feb 5, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi!

I'm trying to trying to automate a lookup process in VBA, but I can't really get it to work. Would really appreciate if anyone could help me with this. So, here's what I'm trying to do:

I want to automatically populate cell F4 with a number wich is in the first part of a string on a website, after entering a 9 digit number in cell C5. Here's the process described with example numbers:

  1. First the user enter the nine digit number in cell C5, example: 915690823
  2. Then, the VBA opens an internet browser on this specific website: Nøkkelopplysninger fra Enhetsregisteret - Brønnøysundregistrene
  3. Then copy the value in cell C5 to the search field called "Organisasjonsnummer" (when opening the Inspect Element, we see that the name is "orgnr") and enter do the search (button called "Søk").
  4. The result shows now open data about a specific businesses in Norway, and down at the page we see that the table displays "Næringskode(r):", and the string next to it in this example shows "70.220 Bedriftsrådgivning og annen administrativ rådgivning" (when opening the Inspect Element, we see that the class is "col-sm-8")
  5. Now, I want the VBA to copy the number in the start of the string, in this example "70.220" into cell F4. The number vary in length but is always in the start of the string, separated from the rest with a space.
Anyone who would help me witht his?

Thank you,
All the best,
Stig
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi Stig,

Use below code:

VBA Code:
Sub showDetails()
    'If any element is not available, the program will move to next line.
    On Error Resume Next
    
    Dim HTMLDoc As New HTMLDocument
    Dim ieBrowser As New InternetExplorer
    Dim requiredText As String
       
    'To open and show Internet Explorer
    ieBrowser.Visible = True
    
    'To Open website in Internet Explorer
    ieBrowser.navigate "https://w2.brreg.no/enhet/sok/detalj.jsp?orgnr=" & ActiveSheet.Range("C5")
    
    Do
    ' Wait till the Browser is loaded
    Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
    
    Set HTMLDoc = ieBrowser.document
    
    requiredText = HTMLDoc.getElementsByClassName("col-sm-8")(12).innerText
    ActiveSheet.Range("F4") = Left(requiredText, InStr(1, requiredText, " ") - 1)
    
    Set ieBrowser = Nothing
    Set HTMLDoc = Nothing
End Sub
 

Stig1dre

New Member
Joined
Feb 5, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi Stig,

Use below code:

VBA Code:
Sub showDetails()
    'If any element is not available, the program will move to next line.
    On Error Resume Next
   
    Dim HTMLDoc As New HTMLDocument
    Dim ieBrowser As New InternetExplorer
    Dim requiredText As String
      
    'To open and show Internet Explorer
    ieBrowser.Visible = True
   
    'To Open website in Internet Explorer
    ieBrowser.navigate "https://w2.brreg.no/enhet/sok/detalj.jsp?orgnr=" & ActiveSheet.Range("C5")
   
    Do
    ' Wait till the Browser is loaded
    Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
   
    Set HTMLDoc = ieBrowser.document
   
    requiredText = HTMLDoc.getElementsByClassName("col-sm-8")(12).innerText
    ActiveSheet.Range("F4") = Left(requiredText, InStr(1, requiredText, " ") - 1)
   
    Set ieBrowser = Nothing
    Set HTMLDoc = Nothing
End Sub
Thank you so much for the quick reply, Saurabhj!

When I try this code, I get an error message saying "Compile Error: User-defined type not defined", and the Dim HTMLDoc As New HTMLDocument is marked. Do I have to enable any Reference first?

Stig
 

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Oops! My mistake.

This program requires references to the following in Tools -> References:
1 Microsoft Internet Controls
2. Microsoft HTML Object Library
 

Attachments

  • toolreferences.JPG
    toolreferences.JPG
    43.4 KB · Views: 1

Stig1dre

New Member
Joined
Feb 5, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Oops! My mistake.

This program requires references to the following in Tools -> References:
1 Microsoft Internet Controls
2. Microsoft HTML Object Library
No worries!
Thank you :) Now it works, however, it picks up the class below called "Sectorkode" the second time I run it. It appears to select the next class with the same name below..
 

Stig1dre

New Member
Joined
Feb 5, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Saurabhj, it seems that it works for some numbers, like 986926453 and 915690823, but the code selects the "Sektorkode" (the value below "Næringskode(r)" in the table in on the website) for other numbers I test, such as 920734987 and 997442288.
 

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi Stig,

I got the issue. It is happening due to extra fields.

Made some changes. use below code:

Sub showDetails()
'If any element is not available, the program will move to next line.
VBA Code:
On Error Resume Next
    
    Dim HTMLDoc As New HTMLDocument
    Dim ieBrowser As New InternetExplorer
    Dim requiredText As String, requiredField As String
    
    'variable to specify the row number in excel
    Dim rowno As Integer
    Dim trow As Object
    rowno = 0
    'To open and show Internet Explorer
    ieBrowser.Visible = True
    
    'To Open website in Internet Explorer
    ieBrowser.navigate "https://w2.brreg.no/enhet/sok/detalj.jsp?orgnr=" & ActiveSheet.Range("C5")
    
    Do
    ' Wait till the Browser is loaded
    Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
    
    Set HTMLDoc = ieBrowser.document
    
    For Each trow In HTMLDoc.getElementsByClassName("col-sm-4")
   
        If InStr(1, trow.innerText, "kode(r):") > 0 Then
            requiredText = HTMLDoc.getElementsByClassName("col-sm-8")(rowno).innerText
            ActiveSheet.Range("F4") = Left(requiredText, InStr(1, requiredText, " ") - 1)
        End If
        rowno = rowno + 1
    Next
    
    Set ieBrowser = Nothing
    Set HTMLDoc = Nothing
End Sub
 
Solution

Stig1dre

New Member
Joined
Feb 5, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Great! Thank you so much!
It's highly appreciated :)

Stig
 

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
413
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
My pleasure and Thanks a lot for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,128,207
Messages
5,629,294
Members
416,384
Latest member
frsamiee

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
Top