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]

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

 

[Sharid]

Hi Paul

Im getting this error message Duplicate declaration in current scope, the error is shown in red below, I thought it was the bit in Blue causing the error, I took it out still having the problem. This is the last bit I am stuck on could you please tweak this for me. Your code is below in green and red.

For info, some rows may not have data in them, e.g row 1,2,3 has data, 4 is empty, 5,6, has data, its just the way my code pastes the data in excel, this will change every time. So not sure if your code is looking for last row withot data or FIRST BLANK ROW.


Full Code
Private Sub CommandButton2_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 i As Long
i = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & i).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

 

[Paul Ked]

You didn't post all the code before so I didn't know you'd already dimmed it, or that it was already in a loop!!

    For i = 2 To 500
        If Sheets("Sheet1").Range("A" & i) <> "" Then GoTo Miss
        Sheets("Sheet1").Range("A" & i).Value = ie.Document.getElementsByTagName("a").Item(i).innerText
Miss:
    Next i

 

[Paul Ked]

If you are adding rows to this list every time then you should start your loop from the 1st empty row and use Do-Loop Until rather than a For-Next (otherwise you will run out of rows after 500!).

 

[Sharid]

Paul this is really good, the only problem i'm having is that its not pulling all the URL from the webpage that it opens, it skips some not sure why

if only this is run
Sheets("Sheet1").Range("A" & i).Value = IE.Document.getElementsByTagName("a").Item(i).innerText

then it get all the url,

put if i run your code it does not pull all the url

 

[Paul Ked]

You need two loops, one for the row and one for the url, give me a minute.

 

[Paul Ked]

Try this:

Private Sub CommandButton2_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(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]

Paul

Its giving me an invalid qualifier error message rw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1

The first code seem fine if the URL are different, however if the web page is the same, just the data is diffrent then it does not copy alll the urls, is this because of
IE.Document.getElementsByTagNames

e.g if url are

https://www.bbc.co.uk/
https://www.aljazeera.com/

it seems to work fine as far as i can tell

if the url are
https://www.bbc.co.uk/1234/john
https://www.bbc.co.uk/3456/jane

Only the data is different then it does not seem to pull all the url, I though the issue might be due to getElementsByTagName
The website may be the same page, just different data

<tbody>
</tbody>

 

[Paul Ked]

It shouldn't do unless you have changed the code name of Sheet1, try this instead:

        rw = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1

The url's I don't think I can help with sorry.