StockCharts web scraping using Excel and VBA

Question

I am trying to get data from StockCharts using Excel and VBA. I can list the headers but not the data. Can somebody help me about that?

This is the code:

Sub Scraping_StockCharts()

    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim HTMLIm As MSHTML.IHTMLElement
    Dim HTMLIms As MSHTML.IHTMLElementCollection
    Dim URL As String
    
    Sheets("Results").Range("a1:z10000").ClearContents
    
    URL = "https://stockcharts.com/freecharts/sectorsummary.html?&G=SECTOR_DJUSHP&O=1"
    
    XMLPage.Open "Get", URL, False
    XMLPage.setRequestHeader "Content-Type", "text/xml"
    
    XMLPage.send
    
    HTMLDoc.body.innerHTML = XMLPage.responseText

    Set HTMLIms = HTMLDoc.getElementsByTagName("th")
    
    Row = 1
    Column = 1
           
        For Each HTMLIm In HTMLIms
         
                Sheets("Results").Cells(Row, Column).Value = HTMLIm.innerText
                Column = Column + 1
        
        Next HTMLIm

    Set HTMLIms = HTMLDoc.getElementsByTagName("td")
    
    Row = 2
    Column = 1
      
        For Each HTMLIm In HTMLIms
            
                Sheets("Results").Cells(Row, Column).Value = HTMLIm.innerText
                Column = Column + 1
        Next HTMLIm
        
End Sub

Answer 1

I would do it like this.

Sub Web_Table_Option_Two()
    Dim HTMLDoc As New HTMLDocument
    Dim objTable As Object
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    objIE.Navigate "https://stockcharts.com/freecharts/sectorsummary.html?&G=SECTOR_DJUSHP&O=1"

    Do Until objIE.ReadyState = 4 And Not objIE.Busy
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:03")) 'wait for java script to load
    HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    With HTMLDoc.body
        Set objTable = .getElementsByTagName("table")
        For lngTable = 0 To objTable.Length - 1
            For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                    ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
                Next lngCol
            Next lngRow
            ActRw = ActRw + objTable(lngTable).Rows.Length + 1
        Next lngTable
    End With
    objIE.Quit
End Sub