Ufdjrw

I have below code, which fetch data from a Intranet. But its taking more time to fetch data.can someone help me to modify the code to increase the performance.
Thanks In Advance

Note-I haven't posted URL as it is clients website. Sorry about that.

Sub FetchData() 
Dim IE As Object
Dim Doc As HTMLDocument
Dim myStr As String
On Error Resume Next

 Set IE = CreateObject("InternetExplorer.Application") 'SetBrowser
 IE.Visible = False

IE.navigate "URL" 'Open website
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

Set Doc = IE.Document

Doc.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
Doc.getElementById("txtPassword").Value = InputBox("Please Enter Your 
Password")
Doc.getElementById("BtnLogin").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

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

Dim LastRow As Long

Set wks = ActiveSheet
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowNo = wks.Range("A1:A" & LastRow)
 For rowNo = 2 To LastRow
Doc.getElementById("txtField1").Value = 
ThisWorkbook.Sheets("Sheet1").Range("A" & rowNo).Value
Doc.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

strVal1 = Doc.querySelectorAll("span")(33).innerText
ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = strVal1
strVal2 = Doc.querySelectorAll("span")(35).innerText
ThisWorkbook.Sheets("Sheet1").Range("C" & rowNo).Value = strVal2

Next

End Sub 

Can't guarantee this will run. Points to note:

1. Use of Worksheets collection


2. Use of Option Explicit - this means you then have to use the right datatype throughout. Currently you have undeclared variables and, for example, rowNo is used as a Long and as a range.


3. Removal of On Error Resume Next
   


4. Putting all worksheets into variables


5. Placement of values into array and looping array to get id values. Looping sheet is expensive


6. Use of early binding and adding class to InternetExplorer


7. Assumption that after login a new url present and that you need to navigate back to that before each new loop value


8. Removal of hungarian notation


9. Ids are fastest selector method so no improvement there


10. With your css type selectors, e.g. .document.querySelectorAll("span")(33), you might seek whether there is a single node short selector that can be used, rather than using nodeList

VBA:

Option Explicit 
Public Sub FetchData()
 Dim ie As Object, ie As InternetExplorer
 Dim lastRow As Long, wks As Worksheet, i As Long, ws As Worksheet

 Set ie = New SHDocVw.InternetExplorer 'SetBrowser
 Set ws = ThisWorkbook.Worksheets("Sheet1")
 Set wks = ActiveSheet '<==use explicit sheet name if possible
 lastRow = wks.Cells(wks.rows.Count, "A").End(xlUp).Row
 loopvalues = Application.Transpose(wks.Range("A2:A" & lastRow).Value)

 With ie

 .Visible = False
 .Navigate2 "URL" 'Open website

 While .Busy Or .readyState < 4: DoEvents: Wend

 .document.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
 .document.getElementById("txtPassword").Value = InputBox("Please Enter Your Password")
 .document.getElementById("BtnLogin").Click

 While .Busy Or ie.readyState < 4: DoEvents: Wend

 Dim newURL As String, val1 As String, val2 As String
 newURL = .document.URL

 For i = LBound(loopvalues) To UBound(loopvalues)

 .document.getElementById("txtField1").Value = loopvalues(i)
 .document.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click

 While .Busy Or .readyState < 4: DoEvents: Wend

 val1 = .document.querySelectorAll("span")(33).innerText
 ws.Range("B" & i).Value = val1
 val2 = .document.querySelectorAll("span")(35).innerText
 ws.Range("C" & i).Value = val2

 .Navigate2 newURL

 While .Busy Or ie.readyState < 4: DoEvents: Wend
 Next
 .Quit
 End With
End Sub