• 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.

Trouble dealing with lastrow in my script

shahin

Active Member
First of all, don't laugh at the problem I'm facing to get resolved. It's a beginner level but it makes my head spin. I've written a macro in vba to scrape data from a overly complicated (to me) webpage performing reverse search. The script is doing just awesome. The only problem I'm facing is that I can't fix the last row automatically. The script is supposed to take the search input from "Sheet3" then creating a new worksheet it will write the scraped data. Because of the way I created my loop I can't deal with the last row. For example, the attached file contains search inputs in Range("A2:A5"). I want to make it A2 to whatever the last row is. I tried with "Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)" this but for the weird looping process in my script, it gives wrong results. However if i write manually Range("A2:A1000") and make a go I don't find any problem. When i write the last row dynamically it gives imbalanced results. How can I fix the last row issues and make it dynamic? Thanks in advance. Here is the script.

Code:
Sub Json_Data()
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim Argstring As String, str As Variant
    Dim N As Long, P As Long, vault As Variant, converted As String
    Dim p_val As Object, post As Object, posts As Object, elem As Object
    Dim source As Object, addr As Object, lgd As Object, mad As Object
    Dim pro_id As String, party_id As String, cel As Range, ws As Worksheet
    Dim lrow As Long
     
    Application.ScreenUpdating = False
   
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = "Scraped_Data"
        [A1:H1] = [{"OwnerName","Property Address","LegalDescription","Mailing Address","Total Main Area","Year Built","Land Size","Deed Date"}]
        Range("A2").Select
    End With
   
    For Each cel In Sheet3.Range("A2:A7")   ''This is what I want to make dynamic
        converted = Replace(cel.Value, " ", "+")
        Argstring = "f=" & converted & "&pt=RP%3BPP%3BMH%3BNR&pn=1&ty=2018&st=9&page=1&take=20&so=1&pageSize=20&skip=0&pvty=2017"
        With http
            .Open "GET", "http://search.wcad.org/Proxy/APIProxy.ashx?/API/api/v1/Search/Properties/?" & Argstring, False
            .setRequestHeader "Content-Type", "text/xml"
            .send
            str = Split(.responseText, "ResultList"":")
        End With
       
        N = UBound(str)
        For P = 1 To N
            pro_id = Split(Split(str(P), "PropertyQuickRefID"":""")(1), """,""PartyQuickRefID")(0)
            party_id = Split(Split(str(P), "PartyQuickRefID"":""")(1), """,""OwnerQuickRefID")(0)
   
            With http
                .Open "GET", "http://search.wcad.org/Property-Detail?PropertyQuickRefID=" & pro_id & "&PartyQuickRefID=" & party_id & ", False"
                .send
                html.body.innerHTML = .responseText
            End With
            On Error Resume Next
            Set source = html.getElementById("dnn_ctr1460_View_divOwnersLabel")
            Set addr = html.getElementById("dnn_ctr1460_View_tdPropertyAddress")
            Set lgd = html.getElementById("dnn_ctr1460_View_tdGILegalDescription")
            Set mad = html.getElementById("dnn_ctr1460_View_tdOIMailingAddress")
       
            Set posts = html.getElementsByClassName("improvementTable")(0).getElementsByTagName("tr")
            Set p_val = html.getElementsByClassName("panel")(0).getElementsByTagName("table")(0).getElementsByTagName("tr")(1).getElementsByTagName("td")
            Set post = html.getElementById("dnn_ctr1460_View_tblLandSegmentsData").getElementsByTagName("tr")
            Set elem = html.getElementById("dnn_ctr1460_View_tblSalesHistoryData").getElementsByTagName("td")(0)
           
            ActiveCell = source.innerText
            ActiveCell.Offset(0, 1) = addr.innerText
            ActiveCell.Offset(0, 2) = lgd.innerText
            ActiveCell.Offset(0, 3) = mad.innerText
            ActiveCell.Offset(0, 4) = posts(1).LastChild.PreviousSibling.innerText
            ActiveCell.Offset(0, 5) = p_val(3).innerText
            ActiveCell.Offset(0, 6) = post(0).NextSibling.LastChild.innerText
            ActiveCell.Offset(0, 7) = elem.innerText
            ActiveCell.Offset(1, 0).Select
            On Error GoTo 0
        Next P
    Next cel
    Sheets("Scraped_Data").Columns.AutoFit
    Application.ScreenUpdating = True
End Sub
 

Attachments

  • New_one.xlsm
    21.5 KB · Views: 2
Check it.

Code:
Sub Json_Data()
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim Argstring As String, str As Variant
    Dim N As Long, P As Long, vault As Variant, converted As String
    Dim p_val As Object, post As Object, posts As Object, elem As Object
    Dim source As Object, addr As Object, lgd As Object, mad As Object
    Dim pro_id As String, party_id As String, cel As Range, ws As Worksheet
    Dim lrow As Long, cr As Range
   
    Application.ScreenUpdating = False
   
    With ThisWorkbook
        With .Sheets.Add(After:=.Sheets(.Sheets.Count))
      ' Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
      .Name = "Scraped_Data"
      ' ws.Name = "Scraped_Data"
        .[A1:H1] = [{"OwnerName","Property Address","LegalDescription","Mailing Address","Total Main Area","Year Built","Land Size","Deed Date"}]
        .Range("A2").Select
        End With
    End With
   
    Set cr = Sheet3.Range("A1").CurrentRegion
   
    For Each cel In cr.Offset(1).Resize(cr.Rows.Count - 1)
        converted = Replace(cel.Value, " ", "+")
        Argstring = "f=" & converted & "&pt=RP%3BPP%3BMH%3BNR&pn=1&ty=2018&st=9&page=1&take=20&so=1&pageSize=20&skip=0&pvty=2017"
        With http
            .Open "GET", "http://search.wcad.org/Proxy/APIProxy.ashx?/API/api/v1/Search/Properties/?" & Argstring, False
            .setRequestHeader "Content-Type", "text/xml"
            .send
            str = Split(.responseText, "ResultList"":")
        End With
       
        N = UBound(str)
        For P = 1 To N
            pro_id = Split(Split(str(P), "PropertyQuickRefID"":""")(1), """,""PartyQuickRefID")(0)
            party_id = Split(Split(str(P), "PartyQuickRefID"":""")(1), """,""OwnerQuickRefID")(0)
   
            With http
                .Open "GET", "http://search.wcad.org/Property-Detail?PropertyQuickRefID=" & pro_id & "&PartyQuickRefID=" & party_id & ", False"
                .send
                html.body.innerHTML = .responseText
            End With
            On Error Resume Next
            Set source = html.getElementById("dnn_ctr1460_View_divOwnersLabel")
            Set addr = html.getElementById("dnn_ctr1460_View_tdPropertyAddress")
            Set lgd = html.getElementById("dnn_ctr1460_View_tdGILegalDescription")
            Set mad = html.getElementById("dnn_ctr1460_View_tdOIMailingAddress")
       
            Set posts = html.getElementsByClassName("improvementTable")(0).getElementsByTagName("tr")
            Set p_val = html.getElementsByClassName("panel")(0).getElementsByTagName("table")(0).getElementsByTagName("tr")(1).getElementsByTagName("td")
            Set post = html.getElementById("dnn_ctr1460_View_tblLandSegmentsData").getElementsByTagName("tr")
            Set elem = html.getElementById("dnn_ctr1460_View_tblSalesHistoryData").getElementsByTagName("td")(0)
           
            ActiveCell = source.innerText
            ActiveCell.Offset(0, 1) = addr.innerText
            ActiveCell.Offset(0, 2) = lgd.innerText
            ActiveCell.Offset(0, 3) = mad.innerText
            ActiveCell.Offset(0, 4) = posts(1).LastChild.PreviousSibling.innerText
            ActiveCell.Offset(0, 5) = p_val(3).innerText
            ActiveCell.Offset(0, 6) = post(0).NextSibling.LastChild.innerText
            ActiveCell.Offset(0, 7) = elem.innerText
            ActiveCell.Offset(1, 0).Select
            On Error GoTo 0
        Next P
    Next cel
    Sheets("Scraped_Data").Columns.AutoFit
    Set cr = Nothing
    Application.ScreenUpdating = True
End Sub
 
Hi ,

Does this not work ?
Code:
    lrow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
   
    For Each cel In Sheet3.Range("A2:A" & lrow)
Narayan
 
Hi Narayan, it's always a pleasure to get you in my thread. One last thing to know. Currently, If i run my code twice it throws an error showing "sheet name" already exists. Is it possible to do something so that the code will not throw error no matter how many times I run it. Newly produced sheet name could be changed with each run. No barrier is there.
 
Hi ,

Do you want a new sheet to be added each time you execute the code , or do you want to use the tab named Scraped_Data if it exists ?

Narayan
 
May be you have to check if the worksheet exists or not
Have a look at this example
Code:
Sub Test()
    Dim str As String
    Dim ws As Worksheet

    str = "Scraped_Data"

    With ThisWorkbook
        If Evaluate("=ISREF('" & str & "'!A1)") Then
            Set ws = .Worksheets(str)
            ws.Activate
        Else
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = str
        End If

        [A1:H1] = [{"OwnerName","Property Address","LegalDescription","Mailing Address","Total Main Area","Year Built","Land Size","Deed Date"}]
        Range("A2").Select
    End With
End Sub
 
Last edited:
Back
Top