VBA Looping pulling from web

[jamescooper]

Hello trying to get this to loop:

Sub WebData_2()


    Dim lastRow     As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant


'Create sheet


    lastRow = Sheets("7th Aug 2019").Range("H" & Rows.Count).End(xlUp).Row
    urls = Sheets("7th Aug 2019").Range("H11:H" & lastRow).Value


    For x = LBound(urls) To UBound(urls)
        Prices = getprices(urls(x, 1))
        Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(Prices), 17).Value2 = Prices
    Next x
    
End Sub


Private Function getprices(ByVal URL As String) As Variant


    Dim source As Object
    Dim http As New XMLHTTP60, html As New HTMLDocument
      
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With


Sheets("7th Aug 2019").Range("F5").Value2 = html.querySelector(".price-details--wrapper .value").innerText
Sheets("7th Aug 2019").Range("G5").Value2 = html.querySelector(".price-per-quantity-weight .value").innerText


End Function

Any ideas please?

 

[Domenic]

Are you getting an error? If so, which one and on which line?

 

[Kyle123]

You aren't returning anything from your function, all it will do is overwrite the same 2 cells for every url in your list. You're also resizing a range to 17 columns, where I think you're only wanting to return 2 values from a web request.

I suspect that your function should be like this:

Private Function getprices(ByVal URL As String) As Variant


    Dim source As Object
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim ret(1 To 2) As String
    
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With
    
    ret(1) = html.querySelector(".price-details--wrapper .value").innerText
    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText
 


End Function

I can't work out what you're trying to do with the returned data though, so I can't help - sorry

 

[jamescooper]

Thanks. So this now doesn't return anything and fails on the line:

Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(Prices), 17).Value2 = Prices

with run-time error 13.

Sub WebData_2()




    Dim lastRow     As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant




'Create sheet




    lastRow = Sheets("7th Aug 2019").Range("H" & Rows.Count).End(xlUp).Row
    urls = Sheets("7th Aug 2019").Range("H11:H" & lastRow).Value


    For x = LBound(urls) To UBound(urls)
        Prices = getprices(urls(x, 1))
        Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(Prices), 17).Value2 = Prices
    Next x
    
End Sub


Private Function getprices(ByVal URL As String) As Variant




    Dim source As Object
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim ret(1 To 2) As String
    
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With
    
    ret(1) = html.querySelector(".price-details--wrapper .value").innerText
    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText
 
End Function

 

[Domenic]

The problem may lie in the way you've defined your selector string. For example if .price-details--wrapper and .value are class names, you'll need to remove the space between them so that they are chained together using the dot operator. However, if the former is a class and the latter is an attribute, you'll need to set up your string differently.

If they are both class names, try...

ret(1) = html.querySelector(".price-details--wrapper.value").innerText

If one is a class name and the other is an attribute, try...

ret(1) = html.querySelector(".price-details--wrapper[value]").innerText

Does this help?

 

[jamescooper]

The problem may lie in the way you've defined your selector string. For example if .price-details--wrapper and .value are class names, you'll need to remove the space between them so that they are chained together using the dot operator. However, if the former is a class and the latter is an attribute, you'll need to set up your string differently.

If they are both class names, try...

ret(1) = html.querySelector(".price-details--wrapper.value").innerText

If one is a class name and the other is an attribute, try...

ret(1) = html.querySelector(".price-details--wrapper[value]").innerText

Does this help?

I tried both of those options and I received error code 91 on that line of code.

It may help if I link the 2 URLs as examples:

In H11: https://www.tesco.com/groceries/en-GB/products/303105747
In H12: https://www.tesco.com/groceries/en-GB/products/292285280

Many thanks.

 

[John_w]

Kyle's code in #3 needs:

getprices = ret

immediately before the End Function statement.

 

[jamescooper]

Kyle's code in #3 needs:

getprices = ret

immediately before the End Function statement.

Thanks, so getting there. It is now pulling the data from the following code twice:

    ret(1) = html.querySelector(".price-details--wrapper .value").innerText

and not pulling data for:

    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText

So currently I have:

Sub WebData_2()
    
    Dim lastRow     As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant


'Create sheet


    lastRow = Sheets("7th Aug 2019").Range("H" & Rows.Count).End(xlUp).Row
    urls = Sheets("7th Aug 2019").Range("H11:H" & lastRow).Value


    For x = LBound(urls) To UBound(urls)
        Prices = getprices(urls(x, 1))
        Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 6).End(xlUp).Offset(1).Resize(UBound(Prices), 1).Value2 = Prices
  
    Next x
    
End Sub


Private Function getprices(ByVal URL As String) As Variant




    Dim source As Object
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim ret(1 To 2) As String
    
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With
    
    ret(1) = html.querySelector(".price-details--wrapper .value").innerText
    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText
 
getprices = ret


End Function

Thanks.

 

[jamescooper]

So changing to the 2 in bold from 1, ensures both are pulled. But it is not duplicating it so I get 3.00, 3.00,

Any ideas?

Sub WebData_2()
    
    Dim lastRow     As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant


'Create sheet


    lastRow = Sheets("7th Aug 2019").Range("H" & Rows.Count).End(xlUp).Row
    urls = Sheets("7th Aug 2019").Range("H11:H" & lastRow).Value


    For x = LBound(urls) To UBound(urls)
        Prices = getprices(urls(x, 1))
        Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 6).End(xlUp).Offset(1).Resize(UBound(Prices), [B]2[/B]).Value2 = Prices
  
    Next x
    
End Sub


Private Function getprices(ByVal URL As String) As Variant




    Dim source As Object
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim ret(1 To 2) As String
    
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With
    
    ret(1) = html.querySelector(".price-details--wrapper .value").innerText
    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText
 
getprices = ret


End Function

 

[Domenic]

Prices get assigned a two-element one-dimensional horizontal array. Therefore, to transfer the contents of the array to a horizontal range of cells, try...

Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 6).End(xlUp).Offset(1).Resize(, UBound(Prices)).Value2 = Prices

To transfer the contents to a vertical range of cells, try...

Sheets("7th Aug 2019").Cells(Sheets("7th Aug 2019").Rows.Count, 6).End(xlUp).Offset(1).Resize(UBound(Prices)).Value2 = Application.Transpose(Prices)