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

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
636
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.

Code:
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

Board Regular
Joined
Dec 30, 2018
Messages
203
Hi,
How about this?

Code:
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

Well-known Member
Joined
Sep 8, 2014
Messages
636
Thanks, its close I am getting run time error 1004 on the line:

Code:
    Sheets("Comparison").Cells(NoRows, 7).End(xlUp).Offset(OffsetNo).Resize(, UBound(Prices)).Value2 = Prices
I have defined those additional variables:

Code:
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

Board Regular
Joined
Dec 30, 2018
Messages
203
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.
Code:
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

Well-known Member
Joined
Apr 28, 2004
Messages
75,275
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.
Code:
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
 

Forum statistics

Threads
1,078,235
Messages
5,339,003
Members
399,274
Latest member
WilliamWavehill

Some videos you may like

This Week's Hot Topics

Top