Paste on next blank row

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,066
Office Version
  1. 2016
Platform
  1. Windows
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
 
Sorry, my bad (I'm cooking for a dinner party so not in full concentration mode!)

Code:
rw = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row + 1
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
@Juba, probably the only reason you were having to use On Error Resume Next in

Code:
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

Code:
For i = 0 To 500
should have been
Code:
For i = 1 To 500

and so you can probably remove it now.
 
Upvote 0
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. :)
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top