Need HELP on Writing A Loop

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,064
Office Version
  1. 2016
Platform
  1. Windows
I need help on writing a loop for the Classes below in the code. I have being trying but I got stuck in a infinite loop and a loop that would only extract only the first prodoct over and over. I have removed all refferences to a loop so the code looks as clean as it can be. The code itself work, but does not loop for each item and I don't know how to write a loop.

Idealy I would not want the code changed as I undestand this code a lot better, I'm sure vba expert could write it a lot better. I did try to use Dim i As Long and then placed it in here, for ALL of the classes
  • Before = doc.getElementsByClassName("vip")(0).href
  • After = doc.getElementsByClassName("vip")(i).href
However this prevents me from then being able to extract child elements, which is a MUST.

Right now I would be happy with just a loop, I think it would be a FOR LOOP so For each item in doc.getElementsByClassName it would extract the data for each product and then move onto the next item. The number of products will be dynamic.

What the code does
It seaches a class. If there is NOTHING to extract it places a hyphen in the cell
VBA Code:
    If doc.getElementsByClassName("lvtitle")(0) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
Else
If there is data then it extracts it and places it in the cell
VBA Code:
   dd = doc.getElementsByClassName("lvtitle")(0).innerText   '.Children(1)
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd

Currently I can extract the child element, as long as the (0).innerText is free and does not have an "i" in it as part of a loop e.g (i).innerText

None of my loops worked.

VBA Code:
Private Sub CommandButton1_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 wsSheet As Worksheet
Dim dd As Variant
Dim wb As Workbook

Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .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

Set wb = ThisWorkbook
         Set wsSheet = wb.Sheets("Sheet1")
    

' I NEED A LOOP HERE FOR EACH doc.getElementsByClassName

    'URL Link
             
            If doc.getElementsByClassName("vip")(0) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
                Else
                    dd = doc.getElementsByClassName("vip")(0).href  'innerText
                         wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = dd
                Cells.WrapText = False
                        End If

    'Title
            If doc.getElementsByClassName("lvtitle")(0) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
            Else
                dd = doc.getElementsByClassName("lvtitle")(0).innerText   '.Children(1)
                    wsSheet.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")(0) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").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
                 End If

    'Current price
            If doc.getElementsByClassName("prRange ")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = "-"
                Else
                    dd = doc.getElementsByClassName("prRange")(i).innerText
                            Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = dd
                End If
                     
    'Sub Title
            If doc.getElementsByClassName("lvsubtitle")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = "-"
                Else
                    dd = doc.getElementsByClassName("lvsubtitle")(i).innerText
                        Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = dd
                End If
                              
    'Previous Price
            If doc.getElementsByClassName("stk-thr")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = "-"
                Else
                    dd = doc.getElementsByClassName("stk-thr")(i).innerText
                        Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = dd
                End If
      
    'Shipping
            If doc.getElementsByClassName("bfsp")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = "-"
            Else
                dd = doc.getElementsByClassName("bfsp")(i).innerText
                    Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = dd
            End If

  
IE.Quit
    Set IE = Nothing
    Set HTMLDoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing
MsgBox "All Done"
End Sub

Thanks in advance
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
so this doesn't work? What error are you getting?

VBA Code:
Private Sub CommandButton1_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 wsSheet As Worksheet
Dim dd As Variant
Dim wb As Workbook

Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .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

Set wb = ThisWorkbook
         Set wsSheet = wb.Sheets("Sheet1")
    

' I NEED A LOOP HERE FOR EACH doc.getElementsByClassName

    'URL Link

            
             
     For i = 0 To 20
     
            If doc.getElementsByClassName("vip")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
                Else
                    dd = doc.getElementsByClassName("vip")(i).href  'innerText
                         wsSheet.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
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
            Else
                dd = doc.getElementsByClassName("lvtitle")(i).innerText   '.Children(1)
                    wsSheet.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
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").Value = "-"
                Else
                dd = doc.getElementsByClassName("hotness-signal red")(i).innerText
                        Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").Value = dd
                 End If

    'Current price
            If doc.getElementsByClassName("prRange ")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = "-"
                Else
                    dd = doc.getElementsByClassName("prRange")(i).innerText
                            Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = dd
                End If
                     
    'Sub Title
            If doc.getElementsByClassName("lvsubtitle")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = "-"
                Else
                    dd = doc.getElementsByClassName("lvsubtitle")(i).innerText
                        Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = dd
                End If
                              
    'Previous Price
            If doc.getElementsByClassName("stk-thr")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = "-"
                Else
                    dd = doc.getElementsByClassName("stk-thr")(i).innerText
                        Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = dd
                End If
      
    'Shipping
            If doc.getElementsByClassName("bfsp")(i) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = "-"
            Else
                dd = doc.getElementsByClassName("bfsp")(i).innerText
                    Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = dd
            End If
     Next i
  
IE.Quit
    Set IE = Nothing
    Set HTMLDoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing
MsgBox "All Done"
End Sub
 
Upvote 0
I have tried something like this, it assumes that there is an X amount of products to extract the data from, if my understand is correct, 20 products in this case.
VBA Code:
 For i = 0 To 20

With what you have done the problems are as such:
  1. The number of products is dynamic and will keep changing as I will add a page navigation later on, so it will be extracting from several pages.
  2. You have added an "i" in here (i).innerText this helps with the loop but stops me from being able to extract child elements, currently I set them all to 0 as I wanted the code to look as clean as possible for some help. Each (0).innerText will be set to extract the correct CHILD element/node
As I pointed out above.
Idealy I would not want the code changed as I undestand this code a lot better, I'm sure vba expert could write it a lot better. I did try to use Dim i As Long and then placed "i" in here, for ALL of the classes
  • Before = doc.getElementsByClassName("vip")(0).href
  • After = doc.getElementsByClassName("vip")(i).href
However this prevents me from then being able to extract child elements, which is a MUST.
 
Upvote 0
I have added a FOR EACH Loop this to the start and got the results as below, but only for the First time and First Item. So I tried this,

VBA Code:
  For Each dd In doc.getElementsByClassName("ADD THE RIGHT CLASS HERE") 
        
   ' ******* Code here ********

  End if
Next dd

I could not product the results as the first row for other items, see image


VBA Code:
    'URL Link
 For Each dd In doc.getElementsByClassName("vip")            
            If doc.getElementsByClassName("vip")(0) Is Nothing Then
                    wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
                Else
                    dd = doc.getElementsByClassName("vip")(0).href  'innerText
                         wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = dd
                Cells.WrapText = False                       
    End If
Next dd

1586186167907.png
 
Upvote 0
Hi

Can someone help, my searches are now coming up like this I have no idea what I am doing when trying to create a loop
1586204676074.png


I added this to the code, still not having any luck as I don't really know what I am doing. ?:unsure:

VBA Code:
Dim counter     As Long
    counter = 0

' ******** My Code ****** which is above and then

   counter = counter + 1
  Next dd
 
Upvote 0
I have since removed all my addin codes and wrote it again to pull off the the child elements, which it does, but I CAN NOT get it to loop through all the products on the page, I have no idea how to write the loop. Please could someone take a look and advise.

It still pull of details for only 1 product
1586256777392.png


VBA Code:
Private Sub CommandButton3_Click()
' ebay 3rd button
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
 
Upvote 0
Just an update, I have also posted on this forum Click Here, just in case someone see it and say it is cross posted
 
Upvote 0
have you tried putting numbers in a cell and referencing the cells?

VBA Code:
testNum = Sheets("Sheet1").range("A1")
 If doc.getElementsByClassName("vip")(testNum ) Is Nothing Then
 
Upvote 0
Thanks for replying. I not sure if I fully follow what you are advising on, but when i put your code in I got this

1586265653554.png
 
Upvote 0
create a new sheet called "NewSheet" and put 0-10 in cells A1-A11. Let me know if you get the same error. I know that you will have an infinite number but lets try 0-10 for now to see if it works.

VBA Code:
Private Sub CommandButton3_Click()
' ebay 3rd button
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")
Dim cl As Object
'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
 
     
        'URL Link
        With Sheets("Sheet1")
            For Each cl In Sheets("NewSheet").Range("A1:A11")
              If doc.getElementsByClassName("vip")(cl.Value) 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")(cl.Value) 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")(cl.Value) 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")(cl.Value) 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")(cl.Value) 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")(cl.Value) 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")(cl.Value) 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 cl
        End With

'   Close IE
  IE.Quit
    Set IE = Nothing
    Set HTMLDoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing
MsgBox "All Done"
           
End Sub
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,725
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top