Trouble dealing with lastrow in my script

shahin · Oct 25, 2017

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

Deepak · Oct 25, 2017

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

NARAYANK991 · Oct 26, 2017

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

shahin · Oct 26, 2017

@Narayan ,yes it works. I've never found your solution to be faulty. However, what I was doing wrong earlier?

shahin · Oct 26, 2017

@Deepak, no way!! It works like magic. Thanks for the modification to look the code even better.

NARAYANK991 · Oct 26, 2017

shahin said:
@Narayan ,yes it works. I've never found your solution to be faulty. However, what I was doing wrong earlier?

Hi ,

The sheet name is missing , and Excel takes it as the active sheet ; when ever you add a new sheet , that automatically becomes the active sheet.

Narayan

shahin · Oct 26, 2017

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.

NARAYANK991 · Oct 26, 2017

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

shahin · Oct 26, 2017

The latter option will be better which is "tab named Scraped_Data if it exists"

NARAYANK991 · Oct 26, 2017

Hi ,

See the attached file.

Narayan

YasserKhalil · Oct 26, 2017

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

shahin · Oct 26, 2017

@Narayan, Exactly this is what I was after. So very nice. The best way I've come across so far. You are very helpful.

Trouble dealing with lastrow in my script

shahin

Active Member

Attachments

Deepak

Excel Ninja

NARAYANK991

Excel Ninja

shahin

Active Member

shahin

Active Member

NARAYANK991

Excel Ninja

shahin

Active Member

NARAYANK991

Excel Ninja

shahin

Active Member

NARAYANK991

Excel Ninja

Attachments

YasserKhalil

Well-Known Member

shahin

Active Member