I need some help on a loop and I can not work it out. I have been stuck on this bit for sometime. I posted on another forum see link Here . I have not had much luck and now I have posted here, hoping someone can help.
PROBLEM
Currently the code is not looping through all the products, it can take off the first, with child elements (THIS IS IMPORTANT). However it only does the first item over and over again.
My latest code is here or visit the above link for more information
Code
Private Sub CommandButton3_Click()
Dim IE As Object
Dim url As String
Dim i As Long
Dim innerText As Variant
Dim HTMLDoc As Object
Dim doc As Object
Dim href As String
Dim lastrow As Long
Dim dd As Variant
Dim wks As Worksheet: Set wks = ThisWorkbook.Sheets("Sheet1")
'IE setup
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
' Sheet to get url off Sheet1 A2, Product from Sheet1 B2
.Navigate2 Sheets("Sheet1").Range("A2").Value & Replace(Worksheets("Sheet1").Range("B2").Value, " ", "+")
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set doc = IE.document
While IE.readyState <> 4
Wend
End With
For i = 0 To 20 ' This assumes there are 20 products, this wrong product AMOUNT will be dynamic
'URL Link
If doc.getElementsByClassName("vip")(i) Is Nothing Then
dd = doc.getElementsByClassName("vip")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
Else
dd = doc.getElementsByClassName("vip")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = dd
Cells.WrapText = False
End If
'Title
If doc.getElementsByClassName("lvtitle")(i) Is Nothing Then
dd = doc.getElementsByClassName("lvtitle")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
Else
dd = doc.getElementsByClassName("lvtitle")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd
Cells.WrapText = False
End If
'Amount Sold
If doc.getElementsByClassName("hotness-signal red")(i) Is Nothing Then
dd = doc.getElementsByClassName("hotness-signal red")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").Value = "-"
dd1 = doc.getElementsByClassName("hotness-signal red")(1)
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = "-"
Else
dd = doc.getElementsByClassName("hotness-signal red")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").Value = dd
dd1 = doc.getElementsByClassName("hotness-signal red")(1).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = dd1
Cells.WrapText = False
End If
'Current price
If doc.getElementsByClassName("prRange")(i) Is Nothing Then
dd = doc.getElementsByClassName("prRange")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = "-"
Else
dd = doc.getElementsByClassName("prRange")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = dd
Cells.WrapText = False
End If
'Sub Title
If doc.getElementsByClassName("lvsubtitle")(i) Is Nothing Then
dd = doc.getElementsByClassName("lvsubtitle")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = "-"
dd1 = doc.getElementsByClassName("lvsubtitle")(1)
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = "-"
dd2 = doc.getElementsByClassName("lvsubtitle")(2)
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "H").End(xlUp).Row + 1, "H").Value = "-"
dd3 = doc.getElementsByClassName("lvsubtitle")(3)
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "I").End(xlUp).Row + 1, "I").Value = "-"
Else
dd = doc.getElementsByClassName("lvsubtitle")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = dd
dd1 = doc.getElementsByClassName("lvsubtitle")(1).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = dd1
dd2 = doc.getElementsByClassName("lvsubtitle")(2).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "H").End(xlUp).Row + 1, "H").Value = dd2
dd3 = doc.getElementsByClassName("lvsubtitle")(3).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "I").End(xlUp).Row + 1, "I").Value = dd3
Cells.WrapText = False
End If
'Previous Price
If doc.getElementsByClassName("stk-thr")(i) Is Nothing Then
dd = doc.getElementsByClassName("prRange")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "J").End(xlUp).Row + 1, "J").Value = "-"
Else
dd = doc.getElementsByClassName("stk-thr")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "J").End(xlUp).Row + 1, "J").Value = dd
Cells.WrapText = False
End If
'Shipping
If doc.getElementsByClassName("bfsp")(i) Is Nothing Then
dd = doc.getElementsByClassName("bfsp")(0) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "K").End(xlUp).Row + 1, "K").Value = "-"
dd1 = doc.getElementsByClassName("bfsp")(1) '.innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "L").End(xlUp).Row + 1, "L").Value = "-"
Else
dd = doc.getElementsByClassName("bfsp")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "K").End(xlUp).Row + 1, "K").Value = dd
dd1 = doc.getElementsByClassName("bfsp")(1).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "L").End(xlUp).Row + 1, "L").Value = dd
Cells.WrapText = False
End If
Next i ' Next I item
' Close IE
IE.Quit
Set IE = Nothing
Set HTMLDoc = Nothing
Set nextPageElement = Nothing
Set div = Nothing
Set link = Nothing
MsgBox "All Done"
End Sub
Display More