Paste on next blank row

[Sharid]

Hi

How do I get this code to paste data on the next blank row, in sheet1 column A

Sheets("Sheet1").Range("A" & i).Value = IE.Document.getElementsByTagName("a").Item(i).innerText

 

[Paul Ked]

Sorry, my bad (I'm cooking for a dinner party so not in full concentration mode!)

rw = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row + 1

 

[Sharid]

Not changes a thing, just copied and pasted your code in, still having the same problem even with the new line of code you just gave

 

[Paul Ked]

With the code from Post #11 ? I could simulate the earlier error but this one worked ok for me.

 

[Sharid]

Magic, it worked, only tested with 3 url but seems to do the trick, I assume this will not run out of rows after 500 as you stated

 

[Sharid]

Final code if anybody needs it thanks to Paul

Private Sub CommandButton4_Click()

Dim i, j, k, l As Integer
i = 2
k = 2
l = 2
'SHEET2 as sheet with URL
Dim wsSheet As Worksheet, Rows As Long, links As Variant, IE As Object, link As Variant
Set wb = ThisWorkbook
Set wsSheet = wb.Sheets("Sheet2")

'Set IE = InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
Rows = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
links = wsSheet.Range("A1:A" & Rows)

'IE Open Time per page 5sec and check links on Sheet2 Column A
With IE
.Visible = True
Application.Wait (Now + TimeValue("00:00:5"))

For Each link In links
.navigate (link)
While .Busy Or .ReadyState <> 4: DoEvents: Wend

For i = 0 To 500
On Error Resume Next

'Paste in sheet and column
Dim rw As Long

rw = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & rw).Value = IE.Document.getElementsByTagName("a").Item(i).innerText

Next i

'Deletes duplicates in column A Sheet1
Columns(1).RemoveDuplicates Columns:=Array(1)

'navigate links
Next link

End With

'Close IE Browser
IE.Quit
Set IE = Nothing

End Sub

 

[Sharid]

Just added a bit extra in green to pull emails of sites as it was not working on all sites

Private Sub CommandButton4_Click()

Dim i, j, k, l As Integer
i = 2
k = 2
l = 2
'SHEET2 as sheet with URL
Dim wsSheet As Worksheet, Rows As Long, links As Variant, IE As Object, link As Variant
Set wb = ThisWorkbook
Set wsSheet = wb.Sheets("Sheet2")

'Set IE = InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
Rows = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
links = wsSheet.Range("A1:A" & Rows)

'IE Open Time per page 5sec and check links on Sheet2 Column A
With IE
.Visible = True
Application.Wait (Now + TimeValue("00:00:5"))

For Each link In links
.navigate (link)
While .Busy Or .ReadyState <> 4: DoEvents: Wend

For i = 0 To 500
On Error Resume Next

'Paste in sheet and column
Dim rw As Long

rw = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & rw).Value = IE.Document.getElementsByTagName("a").Item(i).innerText

Next i

'Deletes duplicates in column A Sheet1
Columns(1).RemoveDuplicates Columns:=Array(1)

'navigate links
Next link


Set sendAnEmail = IE.Document.getElementsByClassName("a-link-normal pr-email").Item(0)

sendAnEmail.Click

Application.Wait Now + TimeSerial(0, 0, 2)

retrievedEmail = sendAnEmail.innerText
End With

'Close IE Browser
IE.Quit
Set IE = Nothing

End Sub

 

[Paul Ked]

That's good. It won't run out of rows, but you will be limited to 500 url's unless you change that value in the for i = 0 to 500.

Cheers

 

[MARK858]

@Juba, probably the only reason you were having to use On Error Resume Next in

For i = 0 To 500
 On Error Resume Next

is you were using it for a sheet index number when there is no such thing as sheet zero so

For i = 0 To 500

should have been

For i = 1 To 500

and so you can probably remove it now.

 

[Paul Ked]

Thanks Mark, I was 'multitasking' so didn't really pay much attention to the code!

@ JUBA Incidentally, I notice that you have 300 posts and still aren't using code tags.

To use them (and it makes for much easier reading) select your code and click the # button. Alternatively, click the # button and paste your code between the code tags. If you feel a little apprehensive, click 'Go Advanced' below the text box and it will give you a preview of your post.