Repeat script for next cell

[florianheinrich]

Hi All,

I've written the following script:

Sub getStatus() Dim IE As Object: Set IE = CreateObject("InternetExplorer.Application")
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim Status As String


With IE
.Visible = False
.navigate "https://www.vfsvisaonline.com/OnlineTracking/OnlineTracking.aspx"


Do
DoEvents
Loop Until .readyState = 4


End With


IE.document.All("ContentMain_txtgwfNumber").Value = ws.Range("a4")
IE.document.All("ContentMain_txtLastName").Value = ws.Range("b4")
IE.document.All("ContentMain_btnSubmit").Click


Application.Wait (Now + 0.00001)


Status = Trim$(IE.document.getElementByID("ContentMain_lblTrackingMessage").innertext)
ws.Range("c4") = Status
IE.Quit


End Sub

So what I want to do is to loop this through all cells with a value in it. For example where it currently says ws.Range("a4") it must move to ws.Range("a5") and when it currently says ws.Range("b4") it must move to be ws.Range("b5"). Also the result must then be posted to ws.Range("c5").

I hope that makes sense.

 

[Yongle]

Try this (untested)
- loop added and With IE now applied throughout the code

Sub getStatus()

Dim IE As Object: Set IE = CreateObject("InternetExplorer.Application")
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim Status As String
Dim [COLOR=#b22222]r[/COLOR] As Long, [COLOR=#b22222]LastRow[/COLOR] As Long
[COLOR=#b22222]LastRow[/COLOR] = ws.Range("A" & Rows.Count).End(xlUp).Row
    [COLOR=#000080]With IE[/COLOR]
        .Visible = False
        .navigate "https://www.vfsvisaonline.com/OnlineTracking/OnlineTracking.aspx"

        For [COLOR=#b22222]r[/COLOR] = [COLOR=#b22222]4[/COLOR] To[COLOR=#b22222] LastRow[/COLOR]

            Do
            DoEvents
            Loop Until .readyState = 4
    
            .document.All("ContentMain_txtgwfNumber").Value = ws.Range("A" & [COLOR=#b22222]r[/COLOR])
            .document.All("ContentMain_txtLastName").Value = ws.Range("B" & [COLOR=#b22222]r[/COLOR])
            .document.All("ContentMain_btnSubmit").Click
    
            Application.Wait (Now + 0.00001)
    
            Status = Trim$(.document.getElementByID("ContentMain_lblTrackingMessage").innertext)
            ws.Range("C" & [COLOR=#b22222]r[/COLOR]) = Status

        Next [COLOR=#b22222]r[/COLOR]
        .Quit
    [COLOR=#000080]End With[/COLOR]

End Sub

 

[florianheinrich]

Perfect! Works like a charm.

Appreciate the help

 

[Yongle]

thanks for the feedback