Need HELP on Writing A Loop

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
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
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
Thanks for having a look. I have done as you have requested, see images below. The result shown on Sheet1 are all the same

1586269522804.png

1586269575117.png


Result on Sheet1
1586269615405.png


My very first code works, but you can't take child elements of if you use an "i" in (0).innertext. If this does not need an "i", then I can look to going back with that code and use the (0).innertext, to take the child elements off, as the "(0)" is not use by the "i"

if that makes sence

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.
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

VBE313

Well-known Member
Joined
Mar 22, 2019
Messages
684
Office Version
  1. 365
Platform
  1. Windows
instead of
VBA Code:
(0).innertext
do
VBA Code:
(cl.value).innertext
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
Although this works, the ability to take of child elements is NO longer available, unless you know of a work around

NOW
1586270702182.png


Before
1586270856441.png
 

VBE313

Well-known Member
Joined
Mar 22, 2019
Messages
684
Office Version
  1. 365
Platform
  1. Windows
so is it always going to be 0 1 or 2? or how many can .innertext go to? Or is .innertext suppsed to be same number as the className?
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

It depends on the element to how many child elements it has that need extracting. Some may have 1 others may have more. Problem i was having was that if it had more than 1 child element it would place it in the cell below, therefore items would be out on align with each other.

My headings in all the previous images are wrong. I have not changed them yet, so do not use them as a guide.

See image below Item are not in line with the correct colour, as the first two items have 2 child element and it has placed it below the first when extracted.

1586273152985.png
 
Last edited:

VBE313

Well-known Member
Joined
Mar 22, 2019
Messages
684
Office Version
  1. 365
Platform
  1. Windows
so you want to concatenate "Spring's Deal-Free" and "Brand new"? and "FREE Fast Delivery" and "Refurbished"?
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
ideally NO, as I can not filter as well. It would be easier to filter if they where in their own column. However I am not left with much options, as I am limited in coding and wrote something I could understand.

The problem is either I can have it to loop or take child elements off, not both at this moment intime, with this code.

To concatenate is probebly the only option, however it may not always be 3 elements, it could be more or less. It all depends on the PARENT Class and how many child elements it has.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,443
Messages
5,636,311
Members
416,912
Latest member
danluk12

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
Top