Our training courses
Azure C# Excel Microsoft 365 MySQL Power Apps Power Automate Power BI and DAX Python Report Builder SQL SQL Server VBA Macros

Other training resources
Blogs Exercises YouTube tutorials YouTube shorts Test your skills Consultancy Courseware Self-paced courses Newsletters Publications

Our training venues
London Manchester Across the UK At your site Online

Why we are different
Hundreds of published reviews Small class sizes Outstanding courseware Online classroom (Almost) no cancellations Wise Owl trainers only Genuine integrity Invoices after training 30+ years of Wise Owl Our top 100 clients

Details for JayK

JayK has participated in the following threads:

Added by JayK on 20 Apr 2020 at 21:13

I am solving the following issue: I want to scrape a title of website when link inserted in column A and put this value to relevant cell (next to it) in column B. The issue seems to be that once I paste the website in column A, the code reruns the entire list from column A2 to "last row" as defined in the code. Is there any way to only modify column B once a single column A is modified? I.e. if I paste a link in column A36 I get a title in B36, regardless of whether the cell is in the middle of the used range or at the very bottom (i.e. only that very cells gets affected..) I would like to use this without having to re-run multiple inputs as it currently stands; (i.e. the loop "for i =2 to last row")? Also, I would like to change the below from Modular macro i.e. sub to private sub reacting to change (i.e. intersect function) where the 'target' is any cell from A:A range. Many thanks!

the code is as follows:

Sub get_title_header()

Dim wb As Object

Dim doc As Object Dim sURL As String

Dim lastrow As Long

lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row

For i = 2 To lastrow

Set wb = CreateObject("internetExplorer.Application")

sURL = Cells(i, 1) wb.navigate sURL

wb.Visible = False

While wb.Busy

DoEvents Wend ''HTML document

Set doc = wb.document

Cells(i, 2) = doc.Title

On Error GoTo err_clear

Cells(i, 3) = doc.GetElementsByTagName("h1")(0).innerText

err_clear: If Err <> 0 Then Err.Clear Resume

Next

End If

wb.Quit Range(Cells(i, 1), Cells(i, 3)).Columns.AutoFit

Next i

End Sub

Head office

Kingsmoor House

Railway Street

GLOSSOP

SK13 2AA

London

Landmark Offices

99 Bishopsgate

LONDON

EC2M 3XD

Manchester

Holiday Inn

25 Aytoun Street

MANCHESTER

M1 3AE

© Wise Owl Business Solutions Ltd 2024. All Rights Reserved.

End of small page here
Please be aware that our website uses cookies!
I'm OK with this Tell me more ...