HTML Extract via VBA

'##################################################################################################
'################## Variables #####################################################################
'##################################################################################################
Public http             As New XMLHTTP60
Public HTML             As New HTMLDocument
Public lnk              As String
Public innertext        As String
Public r, I, rw, erw    As Long
Public nme              As String

Public Results          As Object
Public itm, itm2        As Object
Public nxt              As HTMLButtonElement
Public tmNewTime        As Date

Sub get_data()

    'Clear Data
    sh01.Rows("2:1048576").Delete Shift:=xlUp

    'Application.ScreenUpdating = True
    Application.ScreenUpdating = False

    rw = 1
    erw = z_sh01.Cells(z_sh01.Rows.Count, 1).End(xlUp).Row

'##################################################################################################
'################## Loop Starts ###################################################################
'##################################################################################################

    Do Until rw > erw

        min = Round((erw - rw) / 60, 0)
        tmNewTime = DateAdd("n", min, Time())

        Application.StatusBar = "Checking item " & rw - 1 & " of " & erw - 1 & " (" & Format(rw / erw, "0%") & "), ETA " & Format(tmNewTime, "h:mm am/pm")

'################## Open Website ##################################################################

        lnk = z_sh01.Cells(rw, 1)

        On Error Resume Next
        With http
            .Open "GET", lnk, False
            .send
            HTML.body.innerHTML = .responseText
        End With
        On Error GoTo 0

'################## Populate ######################################################################

        r = sh01.Cells(sh01.Rows.Count, 1).End(xlUp).Row + 1

        On Error Resume Next
            nme = HTML.getElementsByClassName("pdp__productName")(0).innertext
            If nme <> "" Then pop
            nme = ""
        On Error GoTo 0

        sh01.Rows(r).WrapText = False
        r = sh01.Cells(sh01.Rows.Count, 1).End(xlUp).Row + 1

        rw = rw + 1

        DoEvents

    Loop

'##################################################################################################
'################## Loop Ends #####################################################################
'##################################################################################################

    sh01.Cells.WrapText = False
    sh01.Rows(1).WrapText = True

    sh01.Cells(2, 4).Select
        Application.DisplayAlerts = False
        svas = "C:\Users\Ian Greathead\Google Drive\data scrape\SKU\Superdrug.xlsx"
        Sheets("Superdrug").Copy
        ActiveWorkbook.SaveAs Filename:=svas, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
    Application.DisplayAlerts = True

    sh01.Select

    ThisWorkbook.Saved = True
    Application.Quit

End Sub

Sub pop()

    On Error Resume Next
        sh01.Cells(r, 1) = z_sh01.Cells(rw, 2)                                              'shop sku
        sh01.Cells(r, 2) = "IGSD" & z_sh01.Cells(rw, 2)                                     'our sku
        sh01.Cells(r, 3) = nme                                                              'product name
        sh01.Cells(r, 4) = HTML.getElementsByClassName("pricing__now")(0).outerText         'product price
        sh01.Cells(r, 4) = HTML.getElementsByClassName("pricing__now")(0).innertext
        sh01.Cells(r, 4) = HTML.getElementsByClassName("pricing__now")(0).Value
        sh01.Cells(r, 5) = Int((20 - 1 + 1) * Rnd + 1)                                      'product stock
        sh01.Cells(r, 6) = lnk                                                              'product URL
        sh01.Rows(r).WrapText = False
    On Error GoTo 0

End Sub