On Error, is skipping, but not posting next in correct row

[jamescooper]

If one of the ret(1), ret(2), ret(3) is not found it skips it, but it pastes the next one in that row, rather than skipping; any ideas how to alter the code to achieve this please?

Thanks.

Option Explicit


Sub Get_Prices()
    
    Dim Lastrow     As Long
    Dim LastRow2    As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant


'Create sheet
    Application.ScreenUpdating = False
    
    Lastrow = Sheets("Comparison").Columns("P").Find("*", , xlValues, , xlRows, xlPrevious).Row
    urls = Sheets("Comparison").Range("P21:P" & Lastrow).Value


    For x = LBound(urls) To UBound(urls)
        Prices = getprices(urls(x, 1))
    Sheets("Comparison").Cells(Sheets("Comparison").Rows.Count, 7).End(xlUp).Offset(1).Resize(, UBound(Prices)).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 3) As String
    
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With


On Error Resume Next
    
    ret(1) = html.querySelector(".price-details--wrapper .value").innerText
    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText
    ret(3) = html.querySelector(".price-per-quantity-weight .weight").innerText
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 3) As String
    
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With


On Error Resume Next
    
    ret(1) = html.querySelector(".price-details--wrapper .value").innerText
    ret(2) = html.querySelector(".price-per-quantity-weight .value").innerText
    ret(3) = html.querySelector(".price-per-quantity-weight .weight").innerText
    
getprices = ret


End Function



    
getprices = ret


End Function

 

[Mentor82]

Hi,
How about this?

Sub Get_Prices()
    
    Dim Lastrow     As Long
    Dim LastRow2    As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant
    Dim NoRows&
    Dim OffsetNo&


'Create sheet
    Application.ScreenUpdating = False
    
    Lastrow = Sheets("Comparison").Columns("P").Find("*", , xlValues, , xlRows, xlPrevious).Row
    urls = Sheets("Comparison").Range("P21:P" & Lastrow).Value

    NoRows=Sheets("Comparison").Cells(Sheets("Comparison").Rows.Count
    For x = LBound(urls) To UBound(urls)
        OffsetNo=OffsetNo+1
        Prices = getprices(urls(x, 1))
    Sheets("Comparison").Cells(NoRows, 7).End(xlUp).Offset(OffsetNo).Resize(, UBound(Prices)).Value2 = Prices
    Next x

End Sub

 

[jamescooper]

Thanks, its close I am getting run time error 1004 on the line:

    Sheets("Comparison").Cells(NoRows, 7).End(xlUp).Offset(OffsetNo).Resize(, UBound(Prices)).Value2 = Prices

I have defined those additional variables:

Sub Get_Prices()
    
    Dim Lastrow     As Long
    Dim LastRow2    As Long
    Dim NoRows      As Long
    Dim OffsetNo    As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant


'Create sheet
    Application.ScreenUpdating = False
    
    Lastrow = Sheets("Comparison").Columns("P").Find("*", , xlValues, , xlRows, xlPrevious).Row
    urls = Sheets("Comparison").Range("P21:P" & Lastrow).Value


    NoRows = Sheets("Comparison").Cells(Sheets("Comparison").Rows.Count)
    For x = LBound(urls) To UBound(urls)
        OffsetNo = OffsetNo + 1
        Prices = getprices(urls(x, 1))
    Sheets("Comparison").Cells(NoRows, 7).End(xlUp).Offset(OffsetNo).Resize(, UBound(Prices)).Value2 = Prices
    
Next x

End Sub

 

[Mentor82]

Hi,
Check below, because previously I made a mistake in calvulating NoRows.
By the way, you can make sort and long declarations ex. Dim NoRows as long is the same as Dim NoRows&
Give below code a go and let me know if that works.

Sub Get_Prices()
    
    Dim Lastrow     As Long
    Dim LastRow2    As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant
    Dim NoRows as long
    Dim OffsetNo as long


'Create sheet
    Application.ScreenUpdating = False
    
    Lastrow = Sheets("Comparison").Columns("P").Find("*", , xlValues, , xlRows, xlPrevious).Row
    urls = Sheets("Comparison").Range("P21:P" & Lastrow).Value

    NoRows=Sheets("Comparison").Cells(Rows.Count,7).end(xlup).row
    For x = LBound(urls) To UBound(urls)
        OffsetNo=OffsetNo+1
        Prices = getprices(urls(x, 1))
    Sheets("Comparison").Cells(NoRows, 7).End(xlUp).Offset(OffsetNo).Resize(, UBound(Prices)).Value2 = Prices
    Next x

End Sub

 

[Norie]

Change the function so it doesn't use On Error Resume Next.

With the below, if a value you are looking for isn't found then 'N/A' will be entered in the array but the function will always return something.

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 3) As String
Dim elem As Object

    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With


    Set elm = html.querySelector(".price-details--wrapper .value")

    If Not elm Is Nothing Then
        ret(1) = elem.innerText
    Else
        ret(1) = "N/A"
    End If

    Set elm = html.querySelector(".price-per-quantity-weight .value")

    If Not elm Is Nothing Then
        ret(2) = elem.innerText
    Else
        ret(2) = "N/A"
    End If

    Set elm = html.querySelector(".price-per-quantity-weight .weight")

    If Not elm Is Nothing Then
        ret(3) = elem.innerText
    Else
        ret(3) = "N/A"
    End If

    getprices = ret

End Function

 

[jamescooper]

These solutions are working great. Thanks a lot!

 

[Mentor82]

I'm glad you could help you. Thanks for your feedback.