Option Explicit
Public Sub Get_Web_Data()
Dim webQuery As QueryTable
Dim lastRow As Long
Dim cell As Range
'Create the web query on Sheet3
Set webQuery = Create_Web_Query(Sheets("Sheet3"))
'Sheet1 contains the list of URLs in column A starting at A2
With Sheets("Sheet1")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & lastRow)
cell.Offset(0, 1).Value = ""
webQuery.Connection = "URL;" & cell.Value
webQuery.Refresh BackgroundQuery:=False
'Copy price from column D on web query sheet
With webQuery.Parent
'Original code - required price is in last row but one in column D
'lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
'If lastRow <> 1 Then cell.Offset(0, 1).Value = .Cells(lastRow - 1, "D")
'Amended code - required price is first price from the top in column D - should always be cell D2
cell.Offset(0, 1).Value = .Range("D2").Value
End With
DoEvents
Next
End With
End Sub
Private Function Create_Web_Query(wqSheet As Worksheet) As QueryTable
Dim i As Integer
'Delete all queries on web query sheet
With wqSheet
For i = .QueryTables.Count To 1 Step -1
.QueryTables(i).Delete
Next
.Cells.ClearContents
End With
Set Create_Web_Query = wqSheet.QueryTables.Add(Connection:="URL;", Destination:=wqSheet.Range("A1"))
With Create_Web_Query
.Name = "sokker.org"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With
End Function
