Attribute VB_Name = "quotes"
    
Sub quoteY()
'===================================================================================
'
' This pulls company name and current quotes in from Yahoo to the area
' adjacecnt to a vertical column of ticker symbols that are named "tickers"
'
' It relies on Yahoo's "download spreadsheet" function
' http://finance.yahoo.com/d/quotes.csv?s=yhoo&f=l1
'
' Jason Chroman
' September 14, 2006
'
'===================================================================================
Dim qt As QueryTable
Dim tickerstring, connectstring As String
Dim k As Integer

DeleteHiddenNamesAndQueryTables

tickerstring = commaconcat(Range("tickers"))
connectstring = "URL;http://finance.yahoo.com/d/quotes.csv?s=" & tickerstring & "&f=n"

'pull the names with the first query
Set qt = ActiveSheet.QueryTables.Add(Connection:=connectstring, Destination:=ActiveSheet.Range("tickers").Offset(0, 1))

With qt
    .Name = "T1"
    .AdjustColumnWidth = False
    .RefreshStyle = xlOverwriteCells
    .RefreshOnFileOpen = False
    .Refresh
End With

'pull the prices with the second query
connectstring = "URL;http://finance.yahoo.com/d/quotes.csv?s=" & tickerstring & "&f=l1"

Set qt = ActiveSheet.QueryTables.Add(Connection:=connectstring, Destination:=ActiveSheet.Range("tickers").Offset(0, 2))

With qt
    .Name = "T1"
    .AdjustColumnWidth = False
    .RefreshStyle = xlOverwriteCells
    .RefreshOnFileOpen = False
    .Refresh
End With

'insert current date and time
    Application.Goto Reference:="pulldate"
    ActiveCell.Value = Now
    Application.Goto Reference:="pulltime"
    ActiveCell.Value = Now

End Sub


Sub DeleteHiddenNamesAndQueryTables()

Dim n As Name
Dim strX As String

Dim CountA, CountB As Integer
Dim qt As QueryTable

CountA = 0
For Each n In ActiveSheet.Names
        x = Mid(n.Name, 8, 2)
        If x = "T1" Then
            On Error Resume Next
            n.Delete
            CountA = CountA + 1
        End If
Next n

'CountB = ActiveSheet.QueryTables.Count
CountB = 0
For Each qt In ActiveSheet.QueryTables
    qt.Delete
    CountB = CountB + 1
Next qt

'MsgBox (CountB & " hidden query tables were deleted. " & Chr(13) & "There were " & CountA & " hidden names that were deleted.")


End Sub


Function commaconcat(avec As Range) As String
'given a set of ticker symbols, this function separates them with commas
' any blanks are set as "." dots
Dim i, L, numitems As Integer
Dim val, temp As String

numitems = avec.Rows.Count

For Each cell In avec
    i = i + 1
    L = Len(cell.Value)
    If L = 0 Then
        val = "/"
    Else
        val = cell.Value
    End If

    If i < numitems Then
        temp = temp & val & ","
    Else
        temp = temp & val
    End If

Next cell

commaconcat = temp

End Function

Sub RecordUpdates()
'
' This is just a simple copy/paste
'
    Application.Goto Reference:="currentcase"
    Application.CutCopyMode = False
    Selection.Copy
    Application.Goto Reference:="priorcase"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Goto Reference:="R1C1"
End Sub

    Source: geocities.com/excel_apps