Getting specific cell in web table and paste in excel

TaskyFuji

New Member
Joined
Dec 19, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Good morningy, everyone!

I need another help in vba code, please. I need to get a specific cell content from a web table and paste it into excel. Been trying different things but nothing is working. The VBA code i wrote below was a code i got for another table scraping but it's to get the whole table (if getting the whole table were to work, it would still be acceptable) and I don't know how to specify the cell. However, the code still didn't get the correct table that i need (this page has multiple tables that has the same class name ("listTable). I tried the table class "tr0" but i got a runtime error

Run-time error '91':

Object variable or With block variable not set


I only need the content within the "zip" (in this example, i need 11542). Here is the html code, i hope it's enough. Also, please see VBA code so far. Thank you!

HTML:
<div class="divPageSectionContent" id="HSCProteins">   
<table id="Proteins" class="listTable" style="null">
    <tbody><tr class="tr1">
       
        <th nowrap="" style="width: 10%;">Row #</th>
        <th nowrap="" style="width: 10%;">Protein Role</th>
       
            <th nowrap="">MPIN</th>
       
        <th nowrap="" style="width: 10%;">Serv Protein/Status
        </th>
        <th nowrap="" style="width: 10%;">XIN</th>
        <th nowrap="" style="width: 10%;">Address 1</th>
        <th nowrap="" style="width: 10%;">City</th>
        <th nowrap="" style="width: 10%;">State</th>
        <th nowrap="" style="width: 10%;">Zip</th>
        <th nowrap="" style="width: 10%;">Specialty</th>
       
    </tr>

        <tr class="tr0">
               
            <td>
              
                1
            </td>
            <td>Fac, Requesting</td>
            <td>
               
                000123456
               
            </td>
           
            <td>GLENDALE/INN</td>
           
            <td id="Fet ID">12345678</td>
            <td id="address1">Sample Address</td>
            <td id="city">GLENDALE</td>
            <td align="center" id="state">NY</td>
            <td align="center" id="zip">11542</td>
           
            <td id="specialtyType">&nbsp;</td>
           
        </tr>
        <tr id="medNec0" style="display: none" class="tr1">
            <td colspan="100%">
                <table>
                    <tbody>

VBA Code:
Private Sub CommandButton3_Click()
'Pull Zip
'dimension (set aside memory for) our variables
    Dim mySh As Worksheet, table As Object, tr, td, trCounter%, _
tdCounter%, IE As Object, doc As HTMLDocument
Dim objLink As Object


'Launch IE and wait until fully loaded
    Set IE = New InternetExplorerMedium
    IE.Visible = True
    IE.navigate "https://icue.uhc.com/icue/hsr.uhg"
   
    Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

'Copy Ref# from Audit Sheet
    Worksheets("Audit Sheet").Activate
    Worksheets("Audit Sheet").Range("B2").Select
    Selection.Copy

'Search Ref# in Site
    Set doc = IE.document
   
    doc.getElementById("4").Click
   
        Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
       
      Loop
     
    doc.getElementById("searchID").Value = ActiveCell.Value
    doc.getElementById("filterButton").Click

        Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
       
      Loop
     
      Set mySh = ThisWorkbook.Sheets("Search Sheet")
      mySh.Activate
     
    Set table = doc.getElementsByClassName("tr0")
    For trCounter = 0 To table(0).Rows.Length - 1
    For tdCounter = 0 To table(0).Rows(trCounter).Cells.Length - 1
        mySh.Cells(trCounter + 1, tdCounter + 1) = _
        table(0).Rows(trCounter).Cells(tdCounter).innerText
    Next
Next
   
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Hi, I am unable to open the site mentioned but trying to modify VBA code using information provided.

Do you need only first zip code or all zip codes available in site ?
 
Upvote 0
Hi, I am unable to open the site mentioned but trying to modify VBA code using information provided.

Do you need only first zip code or all zip codes available in site ?
Oh sorry, it's actually a protected site. forgot to mention and/or mask. ? I just need the zip in that line provided and not all zip in site. Thanks!
 
Upvote 0
Hi,

Please check below code (unable to check)
VBA Code:
Sub siteZip()
    On Error Resume Next
    
    Dim HTMLDoc As New HTMLDocument
    Dim ieBrowser As New InternetExplorer
      
    'To open and show Internet Explorer
    ieBrowser.Visible = True
    
    'To Open website in Internet Explorer
    ieBrowser.navigate "https://icue.uhc.com/icue/hsr.uhg"
    
    Do
    ' Wait till the Browser is loaded
    Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
    
    Set HTMLDoc = ieBrowser.document
    
    MsgBox HTMLDoc.getElementById("zip")(0).innerText
    
    Set ieBrowser = Nothing
    Set HTMLDoc = Nothing
End Sub
 
Upvote 0
Solution
Hi,

Please check below code (unable to check)
VBA Code:
Sub siteZip()
    On Error Resume Next
   
    Dim HTMLDoc As New HTMLDocument
    Dim ieBrowser As New InternetExplorer
     
    'To open and show Internet Explorer
    ieBrowser.Visible = True
   
    'To Open website in Internet Explorer
    ieBrowser.navigate "https://icue.uhc.com/icue/hsr.uhg"
   
    Do
    ' Wait till the Browser is loaded
    Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
   
    Set HTMLDoc = ieBrowser.document
   
    MsgBox HTMLDoc.getElementById("zip")(0).innerText
   
    Set ieBrowser = Nothing
    Set HTMLDoc = Nothing
End Sub

Hi,

Please check below code (unable to check)
VBA Code:
Sub siteZip()
    On Error Resume Next
   
    Dim HTMLDoc As New HTMLDocument
    Dim ieBrowser As New InternetExplorer
     
    'To open and show Internet Explorer
    ieBrowser.Visible = True
   
    'To Open website in Internet Explorer
    ieBrowser.navigate "https://icue.uhc.com/icue/hsr.uhg"
   
    Do
    ' Wait till the Browser is loaded
    Loop Until ieBrowser.readyState = READYSTATE_COMPLETE
   
    Set HTMLDoc = ieBrowser.document
   
    MsgBox HTMLDoc.getElementById("zip")(0).innerText
   
    Set ieBrowser = Nothing
    Set HTMLDoc = Nothing
End Sub
Sorry, been very busy and forgot to respond and I was pulled to other projects. Anyway, thanks! It did pull into the msgbox. I needed it to paste to a cell and still worked. Thanks so much!
 
Upvote 0

Forum statistics

Threads
1,214,864
Messages
6,121,981
Members
449,058
Latest member
oculus

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