Macro to pull data in from a website? (or another way?)

[tonywatsonhelp]

Hi Everyone,

I little bit of an unusual one for you now,
I am currentlt looking to buy a new home and as you may all know there are a lot of options in uk at the market as everyone seams to want to sell there home.

I'm getting bogged down with properties and want to create a short list of the top 20 or so properties i'm concidering.

I've put toghther the spreadsheet, but one of the problems i'm having is I'll decide on 2 or 3 to go look at at the weekend and by the time ive got to them they are under offer and I missed out,
sorry this is a long story. let me shorten it!

In my spread sheet I take details of properties from Right Move .co.uk
I'd like a macro that when I open up my workbook, goes into the website vie a link I've put in column J and returns the data from the first two rows of the website

heres a link for an example:

4 bedroom semi-detached house for sale in Grayling Road, Stoke Newington, N16

<tbody>
</tbody><colgroup><col></colgroup>

and the parts I want to pull in is where it says:

[h=1]4 bedroom semi-detached house for sale[/h]<address class="pad-0 fs-16 grid-25">Grayling Road, Stoke Newington</address><small class="property-header-qualifier">Sold STC</small> £1,450,000
I don't care how its come in , all in one cell separate cells I just need this information so I can see if its still for sale and if the price has come down.

So basicly lets try this explanation

macro goes to Column J starts at J2, where it finds a link "4 bedroom semi-detached house for sale in Grayling Road, Stoke Newington, N16" into opens that link (or however it needs to do it) and pulls in the updated information from the first two lines in this case saying "4 bedroom semi-detached house for sale Grayling Road, Stoke Newington <small class="property-header-qualifier">Sold STC</small> £1,450,000" Into cells K2 and any more it needs.
Then goes to J3 and does the same?

P.S Column J will always be links not just addresses)

Can this be done?

please help as it will be a great assit I'm getting house blindness from looking at so many places.

thanks tony

 

[dchaney]

try this (I am sure there are better ways, but I am still learning so hope this helps)

Sub WebDownload()

Dim hl As Hyperlink
Dim ws As Worksheet
Dim stURL As String, stFields As String, stData As String


With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With


Set ws = ActiveSheet
    
For Each hl In ws.Hyperlinks
    stURL = hl.Address
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & stURL, Destination:=Range("$A$1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    stFields = ActiveSheet.UsedRange.find("QR code", LookIn:=xlValues).Address
    
    stData = Range(stFields).Offset(2, 0).Value
    stData = stData & " in " & Range(stFields).Offset(4, 0).Value
    stData = stData & " " & Range(stFields).Offset(6, 0).Value
        
    hl.Range.Offset(0, 1).Value = stData
    
    ActiveSheet.Delete
Next


End Sub

 

[tonywatsonhelp]

dchaney, this is great does exactly what I wanted thank you so much

Tony

 

[dchaney]

My pleasure sir