VBA loop to next url after 15-20 url it start overriding data in same cell. Why it start putting data on wrong cell after some url?

I am trying to get data from url & loop to next and put in next empty column. all working fine but after some URLs start overriding data in seme cell.

Sub pulldata()

    Dim tod As String
    Dim IE As Object
    Dim doc As HTMLDocument

    Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
    Dim TrgRw As Long, TrgCol As Long

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

    IE.navigate "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=NIFTY&date=25APR2019"

    Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

    tod = ThisWorkbook.Sheets("URLList").Range("C2").Value
    Sheets.Add After:=Sheets(Sheets.Count)

    ActiveSheet.Name = tod

    Set doc = IE.document

    For nurl = 2 To 191
        lCol = Range("IV2").End(xlToLeft).Offset(0, 0).Column

        doc.getElementById("underlyStock").Value = ThisWorkbook.Sheets("URLList").Range("A" & nurl).Value
        doc.parentWindow.execScript "goBtnClick('stock');", "javascript"

        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        strVal = Range("IV1").End(xlToLeft).Offset(0, 0).Select
        Set Tbl = doc.getElementById("octable")

        TrgRw = 1
        For Each Rw In Tbl.Rows
            TrgCol = 1
            For Each Cel In Rw.Cells
                ThisWorkbook.Sheets(tod).Cells(1, lCol).Cells(TrgRw, TrgCol).Value = Cel.innerText
                TrgCol = TrgCol + Cel.colSpan   ' if Column span is > 1 multiple
            Next Cel
            TrgRw = TrgRw + 1
        Next Rw
    Next
End Sub

Why VBA start overriding after 15-20 urls.

1 answer

  • answered 2019-04-18 16:42 Ricardo A

    I made some small untested changes. Try it out but it should work.

    Sub pulldata()
        Dim tod As String
        Dim IE As Object
        Dim doc As HTMLDocument
        Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
        Dim TrgRw As Long, TrgCol As Long
        Dim wk As Workbook
        Set wk = ThisWrokbook
        Set IE = CreateObject("InternetExplorer.Application")
    
        IE.Visible = True
        IE.navigate "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=NIFTY&date=25APR2019"
    
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop
    
        tod = wk.Sheets("URLList").Range("C2").Value
        wk.Sheets.Add After:=wk.Sheets(wk.Sheets.Count)
        wk.Worksheets(wk.Sheets.Count).Name = tod
        Set doc = IE.document
        TrgRw = 1
    
        For nurl = 2 To 191
            lCol = wk.Sheets(tod).Range("IV2").End(xlToLeft).Offset(0, 0).Column
            doc.getElementById("underlyStock").Value = wk.Sheets("URLList").Range("A" & nurl).Value
            doc.parentWindow.execScript "goBtnClick('stock');", "javascript"
    
            Do While IE.Busy Or IE.readyState <> 4
                Application.Wait DateAdd("s", 1, Now)
            Loop
    
            strVal = wk.Sheets(tod).Range("IV1").End(xlToLeft).Offset(0, 0).Select
            Set Tbl = doc.getElementById("octable")
    
            For Each Rw In Tbl.Rows
                TrgCol = 1
                For Each Cel In Rw.Cells
                    wk.Sheets(tod).Cells(TrgRw, TrgCol).Value = Cel.innerText
                    TrgCol = TrgCol + Cel.colSpan   ' if Column span is > 1 multiple
                Next Cel
                TrgRw = TrgRw + 1
            Next Rw
        Next
    End Sub