Loop thru Macro and input cell

[crazyeyeschase]

I am working on a set of macros that can search given websites with similar source code to find the price of a product. (each websites source code differs slightly so the macros will also differ slightly)

In the long run ill then run something that will tell me what vendor to purchase each product from based on their price.

The issue I am running into is I need to loop thru an entire column "A" until the cell is empty as more cells may be added in the future. I will then need to input the answer into the adjacent cell in column B.

This code currently does everything i need for now but the looping.

Sub Klempfs()
    Dim IE As Object
    Dim Price As String
    Dim rRng As Range
    Dim rCell As Range

    Set IE = CreateObject("internetexplorer.application")
    Set rRng = Range("A1")

    With IE
        .Navigate ("http://www.klempfsbritishparts.com/search?q=" & rRng)
        .Visible = False
    End With

    Do While IE.readystate <> 4: Wait 5: Loop

    DoEvents
    
    For Each rCell In rRng.Cells
    On Error Resume Next
        Price = IE.document.getElementsByClassName("price")(0).innertext
        Cells(1, "B").Value = Price
        
        If Err.Number = 91 Then
        Cells(1, "B").Value = "N/A"
        End If
    Next rCell

MsgBox "end"
        
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

 

[aRandomHelper]

Try this amended code:

Sub Klempfs()
    Dim IE As Object
    Dim Price As String
    Dim i As Long

    Set IE = CreateObject("internetexplorer.application")
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        With IE
            .Navigate ("http://www.klempfsbritishparts.com/search?q=" & Cells(i, "A").Value)
            .Visible = False
        End With
    
        Do While IE.readystate <> 4: Wait 5: Loop
    
        DoEvents
        
        On Error Resume Next
        Price = IE.document.getElementsByClassName("price")(0).innertext
        Cells(i, "B").Value = Price
        
        If Err.Number = 91 Then
            Cells(i, "B").Value = "N/A"
        End If
    Next
MsgBox "end"
        
End Sub

 

[crazyeyeschase]

Try this amended code:

This creates a run time error code

-2147467259

Which was the same issue I was running into.

If I enable IE.visable and run the macro it doesnt even open IE which means something about the way i am trying to range and search using the range isnt working.

 

[aRandomHelper]

Which was the same issue I was running into.

I thought you meant the code was working fine, except only 1 item at a time, so I just amended it to work in a loop.

This creates a run time error code

Did you try debugging, and if yes which line of code is highlighted?

 

[crazyeyeschase]

I thought you meant the code was working fine, except only 1 item at a time, so I just amended it to work in a loop.


Did you try debugging, and if yes which line of code is highlighted?

It was working fine however today it seems to be having an issue with IE.

I am trying to work thru the errors.

 

[crazyeyeschase]

Well not sure what happened overnight but IE would open Edge and even after dissabaling that feature it still caused an issue.

I since tried making a macro to only open a specific website and that also had a RTE.

Went ahead and saved everything and restarted and it all works great now Thanks for the help.