• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Can't append values after the lastrow

shahin

Active Member
I've written a script in vba using IE to get some content from a webpage. The data are perfectly coming through. However, the only problem I'm facing at this moment is that I would like to rerun this scraper and expect to have the result appended from the existing ones.

What my macro does:

Code:
1. In column one it places the current date
2. In column two it places the category names out of the charts available in that webpage
3. In each "For Col" loop, it takes the input from column 3 to whatever across the right and fill in some inputbox in that webpage in order to extract the populated value and put them in column three. That's it.

Here is the macro:
Code:
Sub GetChartInfo()
    Const Url As String = "https://www.fbatoolkit.com/"
    Dim IE As New InternetExplorer, Html As HTMLDocument
    Dim post As Object, elem As Object, oinput As Object
    Dim R&, C&, inputitm As Variant, otitle As Object, lcol&
      
    lcol = Cells(2, Columns.Count).End(xlToLeft).Column
      
    With IE
        .Visible = False
        .navigate Url
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set Html = .document
    End With
    C = 3
    Do: Set itemvisibility = Html.querySelectorAll("div[class='chart-container']"): DoEvents: Loop While itemvisibility.Length <= -1
    For Col = 3 To lcol
        With Html.querySelectorAll("div[class='chart-container']")
            For I = 0 To .Length - 1
                If Cells(I + 3, 1) = vbNullString Then Cells(I + 3, 1) = Date
                Do: Set otitle = .item(I).querySelector(".chart"): DoEvents: Loop While otitle Is Nothing
                If Cells(I + 3, 2) = vbNullString Then Cells(I + 3, 2) = Application.WorksheetFunction.Proper(Replace(Replace(Split(otitle.getAttribute("id"), "visualization_")(1), "__", " "), "_", " "))
                Do: Set oinput = .item(I).querySelector("input.estimator-input"): DoEvents: Loop While oinput Is Nothing
                oinput.innerText = Cells(2, Col).Value
                oinput.NextSibling.Click
                Application.Wait Now + TimeValue("00:00:03")
                Do: Set elem = .item(I).querySelector(".estimator-result div"): DoEvents: Loop While elem Is Nothing
                Cells(I + 3, C).Value = elem.innerText
            Next I
            C = C + 1
        End With
    Next Col
End Sub

I've attached an image of that data filled in sheet. What I want to do is rerun the macro and the macro should start after the data I've already collected. That means it will find the lastrow and start from there no matter how many times I run. I've attached the macro within a workbook for your consideration.
 

Attachments

  • Untitled.jpg
    Untitled.jpg
    250 KB · Views: 10
  • Demo.xlsm
    39.4 KB · Views: 5
You can do it like this. You might want to look at optimizing for speed more.
Code:
Sub GetChartInfo()
  Const Url As String = "https://www.fbatoolkit.com/"
  Dim IE As New InternetExplorer, Html As HTMLDocument
  Dim post As Object, elem As Object, oinput As Object
  Dim R&, C&, inputitm As Variant, otitle As Object, lcol&
     
  lcol = Cells(2, Columns.Count).End(xlToLeft).Column
     
  With IE
    .Visible = False
    .navigate Url
    While .Busy = True Or .readyState < 4: DoEvents: Wend
    Set Html = .document
  End With
  C = 3
  R = Cells(Rows.Count, "A").End(xlUp).Row + 1
  Do: Set itemvisibility = Html.querySelectorAll("div[class='chart-container']"): DoEvents: Loop While itemvisibility.Length <= -1
  For Col = 3 To lcol
    With Html.querySelectorAll("div[class='chart-container']")
      For I = 0 To .Length - 1
        If Cells(I + R, 1) = vbNullString Then Cells(I + R, 1) = Date
        Do: Set otitle = .item(I).querySelector(".chart"): DoEvents: Loop While otitle Is Nothing
        If Cells(I + R, 2) = vbNullString Then Cells(I + R, 2) = Application.WorksheetFunction.Proper(Replace(Replace(Split(otitle.getAttribute("id"), "visualization_")(1), "__", " "), "_", " "))
        Do: Set oinput = .item(I).querySelector("input.estimator-input"): DoEvents: Loop While oinput Is Nothing
        oinput.innerText = Cells(2, Col).Value
        oinput.NextSibling.Click
        Application.Wait Now + TimeValue("00:00:03")
        Do: Set elem = .item(I).querySelector(".estimator-result div"): DoEvents: Loop While elem Is Nothing
        Cells(I + R, C).Value = elem.innerText
      Next I
      C = C + 1
    End With
  Next Col
End Sub
 
Back
Top