PDA

View Full Version : Solved: Help for loop function



Trent
11-18-2012, 10:50 PM
Hi all, first time poster.
Some help with the following would be appreciated. I'm working with Excel 2003 VBA on a single spreadsheet.
Basically the code below is meant to check the value in each cell in range "A:A" (beginning with A2 and running down the column) until an empty cell is reached. The values in each cell form the end of a url in which InternetExplorer adds to a base url and navigates, grabs the "characteristics" table and pastes it into the active sheet followed by a little formatting and cleaning up.

After checking the value in A2/retrieving the table/formatting... I need to understand how to move down to the next cell in "A:A" and perform the same check/navigation/retrieval etc.

If anyone could enlighten me or modify the code that would be fantastic.
Also, I currently have just over 250 values down column A in the spreadsheet which this code will check. If anyone can see a way of making the code more efficient that would be really helpful.

Thanks in advance.

Sub TempleStatGrab()
'
' TempleStatGrab Macro
' Macro recorded 19/11/2012 by
'
' Keyboard Shortcut: Ctrl+g
'
ActiveSheet.Range("A2").Select
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject


Set ieApp = New InternetExplorer

ieApp.Visible = True

ieApp.navigate "****"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

Set ieDoc = ieApp.document

With ieDoc.forms(0)
.UserName.Value = "****"
.Password.Value = "****"
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

For Each cell In Range("A:A")
If ActiveCell.Value Is Not Empty Then
ieApp.navigate "****" & ActiveCell.Value
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.document
Set ieTable = ieDoc.all.Item("characteristics")
Next

If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "<html>" & ieTable.outerHTML & "</html>"
clip.PutInClipboard
Sheet2.Range("D1").Select
ActiveSheet.PasteSpecial "Unicode Text"
'i'll add code here to format & place the data where it neeeds to go
End If


End Sub

patel
11-18-2012, 11:39 PM
attach a sample file with current sheet and desired sheet

remy988
11-20-2012, 05:25 AM
you are missing the Next statementFor Each cell In Range("A:A")
Next

i would do something like this, which takes into account the last row of data in column A
Set r = Range("a1", Range("a" & Rows.Count).End(xlUp))
For Each cell In r
If Not IsEmpty(cell) Then
'code goes here
End If
Next

Trent
11-20-2012, 10:36 PM
Ok, modified code below.

It still only does the job for row 2.
FYI, row 1 is a header row.
I've reduced the values in column A to just 4 for testing purposes.
So that's cells A2, 3, 4 & 5 with values in them.
However because I've left IE visible, I can see the browser loads or reloads the webpage generated from the value in A2 the same number of times as there is non-empty cells in column A (from A2 onwards).
Somehow its recognising the correct number of non-empty cells in our range but not reading their values for navigating to the correct URL.
On the spreadsheet, it doesn't appear to re-post the split data to the offset cells on the 2nd, 3rd & 4th reloads of the webpage.

I've attached a sample workbook containing this code for what its worth. However I've had to remove the actuall url's because this forum removes that privilege until I've made 5 posts in total. (I'm a total newbie). :yes
Also the navigation passes through a login page so for obvious reasons I've removed the login values. You should at least be able to see the spreadsheet structure and how the retrieved data is offset into columns 2 & 3.

Again, any further help is much appreciated. I've added some notes to the code to help visualise what I'm trying to do.


Sub TempleStatGrab()
'
' TempleStatGrab Macro
' Macro recorded 19/11/2012 by
'
' Keyboard Shortcut: Ctrl+g
'
ActiveSheet.Range("A2").Select
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject


'create a new instance of ie
Set ieApp = New InternetExplorer

'for debugging
ieApp.Visible = True

'navigate to login page
ieApp.navigate "url"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

Set ieDoc = ieApp.document

'fill in login form using the page's control names
With ieDoc.forms(0)
.UserName.Value = "****"
.Password.Value = "****"
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

'navigate to "url/ActiveCell.value" and retrieve outerText of specific HTML element, split data and offset into two cells on same row
'then continue moving down one cell at a time in column A and repeat data retrieval (with split and offset) until an empty cell is reached
Dim r As Range
Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
'we're starting at A2 because it has the first usable value
For Each cell In r
If Not IsEmpty(cell) Then
ieApp.navigate "url" & ActiveCell.Value
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Dim sDD As String
sDD = Trim(ieDoc.getElementsByTagName("td")(17).outerText)
Dim aDD As Variant
aDD = Split(sDD, " ")
ActiveCell.Offset(0, 1).Value = aDD(0)
ActiveCell.Offset(0, 2).Value = aDD(1)
End If
Next

End Sub

remy988
11-21-2012, 04:36 AM
this should be the problem
ieApp.navigate "url" & ActiveCell.Value
ActiveCell.Offset(0, 1).Value = aDD(0)
ActiveCell.Offset(0, 2).Value = aDD(1)

because the active cell remains where your cursor is.

try removing "Active"
ieApp.navigate "url" & Cell.Value
Cell.Offset(0, 1).Value = aDD(0)
Cell.Offset(0, 2).Value = aDD(1)

Trent
11-21-2012, 02:09 PM
Solved!
Thanks remy988!

I modified the If conditions as you suggested.
At this point data was retrieved only from the URL&value of A2 but was offset into cells for all rows that weren't empty. So A3, A4 & A5 had data in their adjacent columns that was only correct for A2 or row 2.

If Not IsEmpty(cell) Then
cell.Select
ieApp.navigate "URL" & ActiveCell.Value
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Dim sDD As String
sDD = Trim(ieDoc.getElementsByTagName("td")(17).outerText)
Dim aDD As Variant
aDD = Split(sDD, " ")
cell.Offset(0, 1).Value = aDD(0)
cell.Offset(0, 2).Value = aDD(1)
End If

I then added: cell.select
...after each cell is checked. This means that once the next cell is checked and the conditions are met...that cell actually gets selected for the following URL navigation. Beforehand, each cell was getting checked but only A2 was ever selected.

I'm beyond happy that this worked out. The time that this will save me is incredible. Thank you especially for the quick responses!