Looping an existing sub

[hockeyfanm13]

Hey everyone. I used a youtube video to modify a sub to help me track sent packages. It works perfectly for the first tracking number. However, I'm a little confused as to how to make the sub loop correctly down the "A" column to show results in the "C" and "D" columns. In the actual file, I will be using columns "I" & "J". I was also thinking about putting a wait time of about 15 seconds between each loop as it takes a few seconds to pull the data from the site. Essentially I will be exporting the shipment information at the end of the day and copying it into the worksheet, which is why I have it set to "Worksheet Change".
(Tracking Numbers are non working)

[TABLE="width: 500"]
<tbody>[TR]
[TD]6234982497249
[/TD]
[TD][/TD]
[TD]Delivered: 01/01/01
[/TD]
[TD]Left at Front Porch
[/TD]
[/TR]
[TR]
[TD]2498273498237
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2389723948723[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4230974239743
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2349023409234
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row =Range("a1").Row And _
Target.Column =Range("a1").Column Then
Dim IE As New InternetExplorer
'IE.Visible = True
IE.navigate"https://wwwapps.ups.com/WebTracking/track?track=yes&trackNums="& Range("a1").Value
Do
DoEvents
Loop Until IE.readyState =READYSTATE_COMPLETE
Dim doc As HTMLDocument
Set doc = IE.document
Dim sDiv As String
sDiv = Trim(doc.getElementsByClassName("ups-groupups-group_condensed")(0).innerText)
Dim sriv As String
sriv =Trim(doc.getElementsByClassName("ups-groupups-group_condensed")(1).innerText)

Range("c1") = sDiv
Range("d1") = sriv

End If

End Sub

Any and all help is much appreciated!

 

[hockeyfanm13]

Hey everyone,

After a lot more research I was able to figure it out. If anyone has any pointers to make it even more efficient, I'm all ears.

Private Sub Worksheet_Change(ByVal Target As Range)
     If NotApplication.Intersect(Range("a2:a1500"), Range(Target.Address)) IsNothing Then
    Call TrackingMacro
    End If
End Sub
 
Sub TrackingMacro()
 
 Range("A2").Select
 
 Do UntilActiveCell.Value = ""
 
  Dim IE As NewInternetExplorer
  'IE.Visible = True
  IE.navigate"https://wwwapps.ups.com/WebTracking/track?track=yes&trackNums="& ActiveCell.Value
  Do
  DoEvents
  Loop UntilIE.readyState = READYSTATE_COMPLETE
  Dim doc AsHTMLDocument
  Set doc =IE.document
  Dim sdiv As String
  sdiv =Trim(doc.getElementsByClassName("ups-groupups-group_condensed")(0).innerText)
  Dim sriv As String
  sriv =Trim(doc.getElementsByClassName("ups-groupups-group_condensed")(1).innerText)
  
ActiveCell.Offset(0, 2).Value = sdiv
ActiveCell.Offset(0, 3).Value = sriv
  
 Application.Wait (Now+ TimeSerial(0, 0, 5))
 ActiveCell.Offset(1,0).Select
 
 Loop
End Sub

 

[offthelip]

I think you are likely to run into some probelms by putting this into the "worksheet change" event, accessing the internetcould take awhile and you will locked into it, unable to do anything else while it responds ( or doesn't) in which case you have to try the esc key or shut excel down to get out of it. Also you are writing out to the spreadsheet with these lines:

[COLOR=#000000][FONT=Calibri]ActiveCell.Offset(0, 2).Value = sdiv
[/FONT][/COLOR][COLOR=#000000][FONT=Calibri]ActiveCell.Offset(0, 3).Value = sriv[/FONT][/COLOR]

Although this would appear to be outside the range you are monitoring it is usually good practice to turn events off before writing to the sheet because these will trigger the worksheet_change event again. You are only avoiding the infinite loop because of your intesect statement . so i suggest you put:

[COLOR=#242729][FONT=Consolas]Application.EnableEvents = false[/FONT][/COLOR]

before the writes to the workhseet
and

[COLOR=#242729][FONT=Consolas]Application.EnableEvents = True[/FONT][/COLOR]

after them