We help IT Professionals succeed at work.

Excel get live stock quote

Billy Ma
Billy Ma asked
on
I want to write my own function in Excel to get the real-time quota from the following website and update/refresh every minute.

http://www.aastocks.com/en/ltp/rtquote.aspx?symbol=02318

As you can see, the stock number is at the position after "symbol=" in the URL.

Anyone can let me know how can I do it? I tried to use MSN Monney before but its data does not suitable for Hong Kong market. So I wanna to have my own.

In the Excel sheet 1,
column A, all the stock number typed manually.
column B, the real-time stock quote getting from the above website, of course related to the value typed in column A.

I hope someone can help!

Thank you very much!

Comment
Watch Question

Most Valuable Expert 2012
Top Expert 2012

Commented:
Excel 2003 or 2007+?  Not that it matters, but I'll upload in your version.
Most Valuable Expert 2012
Top Expert 2012

Commented:
Give me a list of 5 stocks you want to monitor for the demo workbook, please.

Dave
Billy MaVice President

Author

Commented:
I am using Excel 2010.

Some sample stock symbol

02318
01398
00005
02388
02888
00939
00011
02628
02800
Billy MaVice President

Author

Commented:
Is it possible to have it on the single worksheet?

How to make it automatically refresh for every 1 minute?
Most Valuable Expert 2012
Top Expert 2012

Commented:
It is possible to have it on one worksheet.  I'm doing a simple webquery, and you can loop it through all the stocks continuously if you wish.
Billy MaVice President

Author

Commented:
I tried to did that in Excel 2011, but I didn't find the web query button...
however, web query need to put the data in a worksheet first...but I only want to have the data i want in the worksheet, not everything...
Billy MaVice President

Author

Commented:
I found the Web Query, but there is no Yellow Arrow on the data I want....
Most Valuable Expert 2012
Top Expert 2012

Commented:
You have to hunt for it:

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.aastocks.com/EN/LTP/RTRecent.aspx?symbol=02318", Destination _
        :=Range("$A$1"))
        .Name = "RTRecent.aspx?symbol=02318"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = True
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Billy MaVice President

Author

Commented:
how to use that?
Most Valuable Expert 2012
Top Expert 2012

Commented:
That's what I'm working on.  

But you can create a simple subroutine and run it to see how it works -

sub test()

code here

end sub

try it.
Most Valuable Expert 2012
Top Expert 2012

Commented:
I'm kind of doing this from scratch.  Everytime I build one of these, I end up losing where I save it...

PS - you might also be interested in: http://www.vertex42.com/ExcelTemplates/excel-stock-quotes.html
Most Valuable Expert 2012
Top Expert 2012

Commented:
There is a problem with how the website works on real-time quotes.  When you do ANOTHER quote, it adds it to the last quote, thus I'm not getting the right record back.  I'm working on how to resolve this.

Dave
Billy MaVice President

Author

Commented:
no no, when you query http://www.aastocks.com/en/ltp/rtquote.aspx?symbol=02318

you always get the same quote.
I am not talk about about to the table.

I just want the real time quote for a particluar share.
Most Valuable Expert 2012
Top Expert 2012

Commented:
Of course you get the same quote - 02318 is hardcoded in your post
Most Valuable Expert 2012
Top Expert 2012

Commented:
Ok - app looks at column a, then builds a web query against each stock symbol with 1 minute refresh (see code to change interval, re: on a minute basis).  There's no need to re-run the macro, unless you've changed the stock symbols.  The web queries are put in place (they aren't one-liners, I couldn't find a link that did that) and then references to where the latest stock price is is stored in column B beside each stock symbol.

You can monitor the Status Bar of Excel to see its progress as its developing each web query...
It can take a few minutes to setup, so wait it out.  Then, you're good to go.

Here's the code:
 
Sub fetchPrices()
Dim wkb As Workbook
Dim wks As Worksheet
Dim scPad As Worksheet
Dim myCell As Range
Dim quoteOffset As Long
Dim getAddr As Range

    Application.DisplayAlerts = False
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("StockQuotes")
    
    On Error Resume Next
    Set scPad = wkb.Sheets("ScratchPad")
    If Err.Number = 0 Then
        scPad.Delete
    End If
    On Error GoTo 0
    
    Set scPad = wkb.Sheets.Add(after:=wkb.Sheets(wkb.Sheets.Count))
    scPad.Name = "ScratchPad"
    quoteOffset = 15
    
    For Each myCell In wks.Range("A2", wks.Range("A" & wks.Rows.Count).End(xlUp))
        Call getStockQuote(myCell.Value, scPad, myCell.Row - 2, quoteOffset, getAddr)
        myCell.Offset(0, 1).Formula = "=" & getAddr.Address(external:=True)
    Next myCell
    
    MsgBox "Web Queries setup - refresh each 1 minute.  There's no need to re-run this macro, unless you've changed the stock symbol list in column A", vbOKOnly
    
End Sub
Sub getStockQuote(stockSymbol As String, wks As Worksheet, srcRow As Long, offsetRows As Long, finalAddr As Range)
Dim downloadURL As String
Dim outCursor As Range

    Set outCursor = wks.Range("A" & srcRow * offsetRows + 1) 'position stock quote the next one down, with offsets
    
    downloadURL = "URL;http://www.aastocks.com/EN/stock/DetailQuote.aspx?symbol=" & stockSymbol
    
    outCursor.Value = "STOCK: " & stockSymbol
    
    With ActiveSheet.QueryTables.Add(Connection:=downloadURL, Destination:=outCursor.Offset(1, 0))
        .Name = "DetailQuote.aspx?symbol=" & stockSymbol
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 1
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "3"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    Set finalAddr = outCursor.Offset(3, 0)
    
End Sub

Open in new window


See attached workbook with your sample stocks already in place.

Enjoy!

Dave
getHKStockQuote-r2.xlsm
Most Valuable Expert 2012
Top Expert 2012
Commented:
Here's an enhancement I think you might like.  It fetches all the stocks via webqueries, one at a time, then fetches all stocks from the RECENT LIST of stocks being monitored at the website...

The way the website works, it creates a list (in your cookies) of every stock you look at.  That way, you can go to the RECENT page:http://www.aastocks.com/EN/LTP/RTRecent.aspx to see the list of stocks that you have teed up.

When this version of the app runs, it adds stocks to the recent list by the nature of doing each of the web queries.  Once the web queries are done, it deletes them, then does ONE query with ONE minute refresh on the RECENT LIST.  The stock prices are then looked up on the primary page by the virtue of an INDEX/MATCH function.

The page will then refresh each 1 minute - more efficiently than the last version.  If you add/delete stocks from the list, just rerun the primary macro and it will ensure the stocks you have are on your recent list.  The query result is ALL STOCKS on your RECENT LIST, so if you're looking at others, they will come to the spreadsheet, but that's ok (just extra data) - you can always go to that RECENT LIST and REMOVE RECORD to clear it, if you like.

The only time you need to run the Setup Prices macro (after your initial load) is if you've cleared your RECENT LIST at the website (hence, clearing your cookies), or if you want to change the stock list.

Here's the code for VERSION 2 - more efficient refreshes:
Sub fetchPrices()
Dim wkb As Workbook
Dim wks As Worksheet
Dim scPad As Worksheet
Dim myCell As Range
Dim quoteOffset As Long
Dim getAddr As Range
Dim lastRow As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("StockQuotes")
    
    On Error Resume Next
    Set scPad = wkb.Sheets("ScratchPad")
    If Err.Number = 0 Then
        scPad.Delete
    End If
    On Error GoTo 0
    
    Set scPad = wkb.Sheets.Add(after:=wkb.Sheets(wkb.Sheets.Count))
    scPad.Name = "ScratchPad"
    quoteOffset = 15
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    For Each myCell In wks.Range("A2:A" & lastRow)
        
        Application.StatusBar = "Fetching Stock: " & myCell.Value & "..."
        
        Call getStockQuote(myCell.Value, scPad, myCell.Row - 2, quoteOffset, getAddr)
        lastSymbol = myCell.Value
    Next myCell
    
    'ok - now that stocks are in the IE list, let's do this again, and grab it in a simple form - with faster refresh
    scPad.Delete
    Set scPad = wkb.Sheets.Add(after:=wkb.Sheets(wkb.Sheets.Count))
    scPad.Name = "ScratchPad"
    
    Application.StatusBar = "Fetching List of Stocks in Selection..."
    
    Call getStockList(scPad)
    
    wks.Range("B2").Formula = "=INDEX('ScratchPad'!A:C,MATCH(A2&""*""" & ",'ScratchPad'!A:A,0),3)"
    wks.Range("B2:B" & lastRow).FillDown
    
    MsgBox "Web Queries setup - refresh each 1 minute.  There's no need to re-run this macro, unless you've changed the stock symbol list in column A", vbOKOnly
    
    wks.Activate
    Application.StatusBar = False
    Application.ScreenUpdating = False
    
    
End Sub
Sub getStockQuote(stocksymbol As String, wks As Worksheet, srcRow As Long, offsetRows As Long, finalAddr As Range)
Dim downloadURL As String
Dim outCursor As Range

    Set outCursor = wks.Range("A" & srcRow * offsetRows + 1) 'position stock quote the next one down, with offsets
    
    downloadURL = "URL;http://www.aastocks.com/EN/stock/DetailQuote.aspx?symbol=" & stocksymbol
    
    With ActiveSheet.QueryTables.Add(Connection:=downloadURL, Destination:=outCursor)
        .Name = "DetailQuote.aspx?symbol=" & stocksymbol
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "3"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    Set finalAddr = outCursor.Offset(3, 0)
    
End Sub
Sub getStockList(wks As Worksheet)
Dim downloadURL As String
Dim outCursor As Range

    Set outCursor = wks.Range("A" & srcRow * offsetRows + 1) 'position stock quote the next one down, with offsets
    
    downloadURL = "URL;http://www.aastocks.com/EN/LTP/RTRecent.aspx"
    
    outCursor.Value = "STOCK LIST:"
    
    With wks.QueryTables.Add(Connection:=downloadURL, Destination:=outCursor.Offset(1, 0))
        .Name = "RTRecent"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 1
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "5,6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Open in new window

See attached workbook.

Enjoy!

Dave
getHKStockQuote-r3.xlsm
Billy MaVice President

Author

Commented:
Really nice, thank you so much! =]