Hi, ballterrier!
Give a look at this file:
https://dl.dropboxusercontent.com/u/60558749/How%20to%20amend%20the%20attached%20VBA%20code%20to%20extract%20stock%20data%20from%20yahoo%20only%20instead%20%28for%20ballterrier%20at%20chandoo.org%29.xlsm
This is the code behind the cyan button in first sheet:
-----
Option Explicit
Sub WebQuery()
' constants
Const ksWSParameters = "Parameters"
Const ksURLPattern = "URLPatternCell"
Const ksURLStep = "URLStepCell"
Const ksWSQuotes = "Quotes"
Const ksData = "DataTable"
Const ksWSWork = "Work"
Const ksDataStart = "Symbol"
Const ksDataEnd = "Showing"
Const ksWildcard = "*"
' declarations
Dim rngP As Range, rngS As Range, rngQ As Range, ws As Worksheet
Dim sURLPattern As String, iURLStep As Integer
Dim lFrom As Long, iReturned As Integer, sURL As String
Dim I As Long, J As Integer, K As Long
' start
' ranges
With Worksheets(ksWSParameters)
Set rngP = .Range(ksURLPattern)
Set rngS = .Range(ksURLStep)
End With
Set rngQ = Worksheets(ksWSQuotes).Range(ksData)
Set ws = Worksheets(ksWSWork)
ws.Activate
' values
sURLPattern = rngP.Cells(1, 1).Value
iURLStep = rngS.Cells(1, 1).Value
rngQ.ClearContents
' process
With rngQ
lFrom = 0
iReturned = -1
Do
' query
sURL = sURLPattern & lFrom
WebQueryData sURL, lFrom
DoEvents
' data
I = 1
Do Until ws.Cells(I, 1).Value = ksDataStart
I = I + 1
Loop
K = 1
Do
If ws.Cells(I + K, 1).Value <> "" Then
For J = 1 To .Columns.Count
If ws.Cells(I + K, J).Value <> "" Then
.Cells(lFrom + K, J).Value = ws.Cells(I + K, J).Value
Else
If ws.Cells(I + K, J + 1).Value = "" Then Exit For
End If
Next J
K = K + 1
End If
Loop Until ws.Cells(I + K, 1).Value Like ksDataEnd & ksWildcard Or _
ws.Cells(I + K, 1).Value = ""
iReturned = K - 1
' cycle
lFrom = lFrom + iURLStep
Loop Until iReturned = 0
End With
' end
Set ws = Nothing
Set rngQ = Nothing
Set rngS = Nothing
Set rngP = Nothing
With Worksheets(ksWSQuotes)
.Activate
.Range("A2"
.Select
End With
Beep
End Sub
Private Sub WebQueryData(psURL As String, plFrom As Long)
' constants
Const ksWSWork = "Work"
' declarations
Dim ws As Worksheet
Dim I As Integer
' start
Set ws = Worksheets(ksWSWork)
ws.Cells.ClearContents
' process
With ws.QueryTables.Add( _
Connection:="URL;" & psURL, Destination:=Cells(plFrom + 1, 1))
.Name = psURL
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells 'xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage 'xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
' .WebTables = ""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
DoEvents
End With
' end
Set ws = Nothing
End Sub
-----
I chose to pull out the data directly from Yahoo Finance for market Australia, as this was your original requirement and the embedded solution into the StockScreener file wasn't any simple to find.
This is up to where I arrived. What you're gonna do with this (process it by yourself, build a new StockScreener, ...) it's beyond the scope of these macros. Hope it helps.
Regards!
PS: Despite of the fact that in this link:
http://au.finance.yahoo.com/lookup/all?s=%2a&t=A&m=AU&r=&b=0 (1st) or in:
http://au.finance.yahoo.com/lookup/all?s=%2a&t=A&m=AU&r=&b=1000 (last)
it says "All(5XXX)" that number isn't correct as for Australia there're just up to 1020 which could be checked manually pressing "Next" in previous link.
