VBA scraping of HTML

Hi all,

Currently I have got a VBA which scrapes through links and tables that are stored inside sheet called web_links. But if you check sheet web_data the data is a little off the columns not where it should be. My question would be how can I update this VBA so it only downloads data from tables with the following ID's: product-name, price-box?

Sub check_prices()
 Dim oHtml As HTMLDocument
 Dim oElement As Object
 Dim a, x, i, ii, webX, LastRow As Long
 Dim nowDate, nowTime As Date
 Dim cat, website As String
 Dim weblinks As Variant
 Dim rng, MyRange As Range
 Dim SHweblinks, SHwebdata As Worksheet
 
 'On Error Resume Next
 
 nowDate = Date
 nowTime = Time
 
Set SHweblinks = ThisWorkbook.Worksheets("web_links")
Set SHwebdata = ThisWorkbook.Worksheets("web_data")
 
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
    End With

With SHwebdata
If .AutoFilterMode = True Then .AutoFilterMode = False
End With

 'Needs a Reference.
 'Go to Tools > Reference > Search for Microsoft HTML Object Library > tick the checkbox > OK
 Set oHtml = New HTMLDocument

    weblinks = SHweblinks.Cells(1).CurrentRegion.Value

For webX = 2 To UBound(weblinks)

 With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", weblinks(webX, 3), False
    .send
    oHtml.body.innerHTML = .responseText
    Debug.Print
 End With

 ReDim a(1 To 100000, 1 To 60)
' For Each oElement In oHtml.getElementsByClassName(weblinks(webX, 4))
 For Each oElement In oHtml.getElementsByClassName(weblinks(webX, 4))
    i = i + 1
    x = Split(oElement.outerText, vbCr)
    
    For ii = 1 To UBound(x)
        a(i, 1) = nowDate
        a(i, 2) = nowTime
        a(i, 3) = weblinks(webX, 1)
        a(i, 4) = weblinks(webX, 2)
        a(i, ii + 4) = Trim$(x(ii))
    Next

 Next oElement
    
    With SHwebdata
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Cells(LastRow + 1, 1).Resize(i, UBound(a, 2)) = a
        i = 0
    End With
 Next

 '' remove line breaks and sterling signs
 Set MyRange = SHwebdata.UsedRange
        MyRange.Replace Chr(10), ""
        MyRange.Replace "£", ""

'' move prices from column H to G
    Set rng = SHwebdata.Range("H:H")
    For Each Cell In rng
        'test if cell is empty
        If Cell.Value <> "" Then
            'write to adjacent cell
            Cell.Offset(0, -1).Value = Cell.Value
            Cell.ClearContents
        End If
    Next

With SHwebdata
    .Columns("A:A").NumberFormat = "dd/mm/yyyy"
    .Columns("B:B").NumberFormat = "hh:mm"
    .Columns("C:F").NumberFormat = "@"
    .Columns("G:G").NumberFormat = "$#,##0.00"
    .Cells.EntireColumn.AutoFit
    .Cells.EntireRow.AutoFit
    '.Range("A:G").RemoveDuplicates Columns:=Array(1, 2, 3, 5), _
    '    Header:=xlYes
End With

    Sheets("pivot").PivotTables("PivotTable1").PivotCache.Refresh
    Sheets("overview").PivotTables("PivotTable1").PivotCache.Refresh
    
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    End With
End Sub