Import live stock quotes

[danielexcel]

Hi,

Just wondering what the easiest way to import a live, self refreshing stock quote would be. I want it to be just the quote ie 62.10 so that it can tidily fit into one little cell.

Thanks​

 

[venkat1926]

For how many stocks do you wantg

see data below. here (better keep minimum two stocks)
time USA Eastern time
you can replace the two stocks yahoo symbols of your two stocks
you can add more stocks also
run only macro "test" though both the macros are be parked in the module. the macros are given below

download

*	A	B	C	D	E	F	G	H	I	J
1	symbol	last trade	time	*	*	*	*	*	*	*
2	ADSL.NS	23.4	5:01am	*	*	*	*	*	*	*
3	AMTEKAUTO.NS	89.35	5:05am	*	*	*	*	*	*	*
4	*		*	*	*	*	*	*	*	*
5	*	*	*	*	*	*	*	*	*	*
6	*	*	*	*	*	*	*	*	*	*
7	*	*	*	*	*	*	*	*	*	*
8	*	*	*	*	*	*	*	*	*	*
9	*	*	*	*	*	*	*	*	*	*
10	*	*	*	*	*	*	*	*	*	*
11	*	*	*	*	*	*	*	*	*	*
12	*	*	*	*	*	*	*	*	*	*
13	*	*	*	*	*	*	*	*	*	*
14	*	*	*	*	*	*	*	*	*	*
15	*	*	*	*	*	*	*	*	*	*
16	*	*	*	*	*	*	*	*	*	*
17	*	*	*	*	*	*	*	*	*	*
18	*	*	*	*	*	*	*	*	*	*

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:107px;"><col style="width:65px;"><col style="width:51px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:64px;"><col style="width:66px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

the macros are (based on smf addin smf_addin : EXCEL Stock Market Functions Add-in)

Sub test()
Dim S, url As String, j As Integer, rg As Range
Dim qr As QueryTable, k As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets("download").Activate


For Each qr In Sheets("download").QueryTables
    qr.Delete
Next qr


Range(Range("B2"), Range("B2").End(xlToRight).Offset(0, -1).End(xlDown)).Cells.Clear
'Set rg = Range("a2")


'Do
k = Range("a2").End(xlDown).Row
For j = 1 To k - 1
S = S & "+" & Range("a2").Offset(j - 1, 0)
Next j
'MsgBox S
S = Right(S, Len(S) - 1)
'MsgBox S
'S = rg.Value
j = 1
'url = "http://quote.yahoo.com/d/quotes.csv?s=" & S & "&f=ohl1c1p2pvd1t1g&e=.csv"
   url = "http://quote.yahoo.com/d/quotes.csv?s=" & S & "&f=l1p2ohgvd1t1&e=.csv"
    url = "http://quote.yahoo.com/d/quotes.csv?s=" & S & "&f=l1t1&e=.csv"
 
       ' With ActiveWorkbook.Worksheets("Data").QueryTables.Add( _
            Connection:="URL;" & url, Destination:=rg.Offset(j - 1, 1))
            With ActiveWorkbook.ActiveSheet.QueryTables.Add( _
            Connection:="URL;" & url, Destination:=Range("B2"))
            
            
            .BackgroundQuery = False
            .RefreshPeriod = 0
            .TablesOnlyFromHTML = False
            .RefreshStyle = xlOverwriteCells
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
        
    'Set rg = rg.Offset(1, 0)
    'If rg = "" Then Exit Do
    'Loop
    texttocol
    MsgBox "download over"
    Application.ScreenUpdating = True
    
    Application.DisplayAlerts = True
    
End Sub
Sub texttocol()
Dim rg As Range
Set rg = Range(Range("B2"), Range("B2").End(xlDown))
    rg.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
Range(Range("A1"), Range("a1").End(xlToRight)).EntireColumn.AutoFit


End Sub