Z
zapper
I was looking for a process to download stock prices;
I was doing it with MSN. It works but adding or deleting
stock symbols with MSN is cumbersome.
So I Googled and found a few offerings.
When I saw Dave Peterson's name that was the first one I tried.
He wrote a macro for me last year that has saved me much time
and aggravation. (Thanks again, Dave)
http://groups.google.com/group/micr...84ac1c94d00/52e0a464fb843011#52e0a464fb843011
Newsgroups: microsoft.public.excel.misc
From: Dave Peterson <[email protected]>
Date: Mon, 06 Jan 2003 17:38:33 -0600
Local: Mon, Jan 6 2003 6:38 pm
Subject: Re: Download Stock prices to excell spreadsheet
===========================================
Dave, this is the macro I copied:
===========================================
Option Explicit
Sub testme()
Application.ScreenUpdating = False
Dim ce As Range
Dim LastRow As Long
Dim myGroup As Long
Dim myStep As Long
Dim iRow As Long
Dim myString As String
Dim myStringEnd As String
Dim qURL As String
myStep = 200
With ActiveSheet
.Columns("B:IV").Delete
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = 1 To LastRow Step myStep
If iRow > LastRow Then Exit For
myString = ""
For Each ce In .Cells(iRow, "A").Resize(myStep)
If ce.Row > LastRow Then Exit For
myString = myString & ce.Value & "+"
Next
myStringEnd = myString + "&f=sl1d1t1c1ohgv&e=.csv"
' MsgBox myStringEnd
'qurl = http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&d=e"
qURL = "http://finance.yahoo.com/d/quotes.csv?s=" & myStringEnd
With .QueryTables.Add(Connection:="URL;" & qURL, _
Destination:=.Cells(iRow, "B"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Next iRow
.Columns("B:iv").SpecialCells(xlCellTypeBlanks).Delete _
Shift:=xlToLeft
Application.DisplayAlerts = False
.Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 3), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1))
Application.DisplayAlerts = True
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
=================================================
Below is the macro I'm running now. When I ran the above version it hung
twice.
I simply deleted the instuctions and re-tried it. Hey, whatta I know.
(I'm not a VBA guy.) It now works beautifully!
=================================================
Sub testme()
' Keyboard Shortcut: Ctrl+Shift+L
'
Application.ScreenUpdating = False
Dim ce As Range
Dim LastRow As Long
Dim myGroup As Long
Dim myStep As Long
Dim iRow As Long
Dim myString As String
Dim myStringEnd As String
Dim qURL As String
myStep = 200
With ActiveSheet
.Columns("B:IV").Delete
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = 1 To LastRow Step myStep
If iRow > LastRow Then Exit For
myString = ""
For Each ce In .Cells(iRow, "A").Resize(myStep)
If ce.Row > LastRow Then Exit For
myString = myString & ce.Value & "+"
Next
myStringEnd = myString + "&f=sl1d1t1c1ohgv&e=.csv"
' MsgBox myStringEnd
'qurl = http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&d=e"
qURL = "http://finance.yahoo.com/d/quotes.csv?s=" & myStringEnd
With .QueryTables.Add(Connection:="URL;" & qURL, _
Destination:=.Cells(iRow, "B"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Next iRow
Application.DisplayAlerts = False
.Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 3), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1))
Application.DisplayAlerts = True
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
=============================================
Here's what I get when I run the macro, cols A-J (of course everything lines
up right)
Initially, it all starts in A1 where I put the ticker symbols in col A and
the cursor in B1.
I put the tickers in lower case, they were changed in col B to upper case by
Yahoo.
I now run the macro by spotting the cursor in C1, then run the macro
and everything is updated. It would be nice to get the name of the stock,
how about that Dave? Could that be one of the instructions I deleted.
A B C D E F G
H I J
symbol/symbol/latest price/date/time/change/open/high/low/volume
cvx CVX 66.79 3/2/2007 4:02pm -0.81 67.58 67.75 66.32 10827300
xom XOM 70.01 3/2/2007 4:02pm -0.98 70.95 71.25 69.31 27456100
ul UL 26.14 3/2/2007 4:01pm -0.37 26.17 26.33 26.06 597100
msft MSFT 27.76 3/2/2007 4:01pm -0.33 28.02 28.16 27.76 63256424
ita ITA 54.67 3/2/2007 3:55pm -0.8 55.34 55.47 54.67 101300
iyg IYG 128.02 3/2/2007 3:56pm -1.68 128.8 129.79 128.02 95500
iyh IYH 65.93 3/2/2007 4:10pm -0.66 66.33 66.691 65.93 76000
iye IYE 96.86 3/2/2007 4:04pm -1.62 98 98.26 96.48 77900
iyr IYR 85.77 3/2/2007 4:15pm -1.81 86.82 87.41 85.77 3777200
iyz IYZ 30.12 3/2/2007 4:15pm -0.34 30.3 30.58 30.12 342800
ige IGE 98.18 3/2/2007 4:16pm -1.92 99.48 99.65 97.85 89400
igm IGM 50.01 3/2/2007 3:59pm -0.82 50.61 50.74 50.01 286500
qqqq QQQQ 42.48 3/2/2007 4:01pm -0.65 42.79 43.14 42.47 183419952
ewj EWJ 14.45 3/2/2007 4:16pm -0.24 14.54 14.58 14.39 31401800
ewy EWY 47.72 3/2/2007 4:15pm -0.41 47.42 48.78 47.42 1956500
ioo IOO 71.37 3/2/2007 3:58pm -0.91 71.87 72.169 71.311 40900
eem EEM 107.96 3/2/2007 4:16pm -1.05 108.05 110.37 107.55 19976076
iev IEV 102.07 3/2/2007 4:15pm -1.35 102.65 103.249 102.06 170100
efa EFA 72.4 3/2/2007 4:16pm -0.99 72.9 73.18 72.34 6951000
ivw IVW 63.25 3/2/2007 4:11pm -0.83 63.5 64.09 63.25 744600
ive IVE 75.72 3/2/2007 4:13pm -1.08 76.6 76.734 75.72 536300
ijk IJK 81.65 3/2/2007 4:03pm -1.19 82.6 82.82 81.46 81600
ijj IJJ 81.37 3/2/2007 4:14pm -1.27 82.68 82.68 81.37 243700
ijt IJT 127.5 3/2/2007 4:14pm -2.44 129.5 129.66 127.5 110100
ijs IJS 74.5 3/2/2007 4:14pm -1.37 75.85 75.85 74.5 236100
gld GLD 63.71 3/2/2007 4:15pm -2.11 64.59 65 63.34 13733200
I was doing it with MSN. It works but adding or deleting
stock symbols with MSN is cumbersome.
So I Googled and found a few offerings.
When I saw Dave Peterson's name that was the first one I tried.
He wrote a macro for me last year that has saved me much time
and aggravation. (Thanks again, Dave)
http://groups.google.com/group/micr...84ac1c94d00/52e0a464fb843011#52e0a464fb843011
Newsgroups: microsoft.public.excel.misc
From: Dave Peterson <[email protected]>
Date: Mon, 06 Jan 2003 17:38:33 -0600
Local: Mon, Jan 6 2003 6:38 pm
Subject: Re: Download Stock prices to excell spreadsheet
===========================================
Dave, this is the macro I copied:
===========================================
Option Explicit
Sub testme()
Application.ScreenUpdating = False
Dim ce As Range
Dim LastRow As Long
Dim myGroup As Long
Dim myStep As Long
Dim iRow As Long
Dim myString As String
Dim myStringEnd As String
Dim qURL As String
myStep = 200
With ActiveSheet
.Columns("B:IV").Delete
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = 1 To LastRow Step myStep
If iRow > LastRow Then Exit For
myString = ""
For Each ce In .Cells(iRow, "A").Resize(myStep)
If ce.Row > LastRow Then Exit For
myString = myString & ce.Value & "+"
Next
myStringEnd = myString + "&f=sl1d1t1c1ohgv&e=.csv"
' MsgBox myStringEnd
'qurl = http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&d=e"
qURL = "http://finance.yahoo.com/d/quotes.csv?s=" & myStringEnd
With .QueryTables.Add(Connection:="URL;" & qURL, _
Destination:=.Cells(iRow, "B"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Next iRow
.Columns("B:iv").SpecialCells(xlCellTypeBlanks).Delete _
Shift:=xlToLeft
Application.DisplayAlerts = False
.Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 3), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1))
Application.DisplayAlerts = True
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
=================================================
Below is the macro I'm running now. When I ran the above version it hung
twice.
I simply deleted the instuctions and re-tried it. Hey, whatta I know.
(I'm not a VBA guy.) It now works beautifully!
=================================================
Sub testme()
' Keyboard Shortcut: Ctrl+Shift+L
'
Application.ScreenUpdating = False
Dim ce As Range
Dim LastRow As Long
Dim myGroup As Long
Dim myStep As Long
Dim iRow As Long
Dim myString As String
Dim myStringEnd As String
Dim qURL As String
myStep = 200
With ActiveSheet
.Columns("B:IV").Delete
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = 1 To LastRow Step myStep
If iRow > LastRow Then Exit For
myString = ""
For Each ce In .Cells(iRow, "A").Resize(myStep)
If ce.Row > LastRow Then Exit For
myString = myString & ce.Value & "+"
Next
myStringEnd = myString + "&f=sl1d1t1c1ohgv&e=.csv"
' MsgBox myStringEnd
'qurl = http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&d=e"
qURL = "http://finance.yahoo.com/d/quotes.csv?s=" & myStringEnd
With .QueryTables.Add(Connection:="URL;" & qURL, _
Destination:=.Cells(iRow, "B"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Next iRow
Application.DisplayAlerts = False
.Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 3), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1))
Application.DisplayAlerts = True
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
=============================================
Here's what I get when I run the macro, cols A-J (of course everything lines
up right)
Initially, it all starts in A1 where I put the ticker symbols in col A and
the cursor in B1.
I put the tickers in lower case, they were changed in col B to upper case by
Yahoo.
I now run the macro by spotting the cursor in C1, then run the macro
and everything is updated. It would be nice to get the name of the stock,
how about that Dave? Could that be one of the instructions I deleted.
A B C D E F G
H I J
symbol/symbol/latest price/date/time/change/open/high/low/volume
cvx CVX 66.79 3/2/2007 4:02pm -0.81 67.58 67.75 66.32 10827300
xom XOM 70.01 3/2/2007 4:02pm -0.98 70.95 71.25 69.31 27456100
ul UL 26.14 3/2/2007 4:01pm -0.37 26.17 26.33 26.06 597100
msft MSFT 27.76 3/2/2007 4:01pm -0.33 28.02 28.16 27.76 63256424
ita ITA 54.67 3/2/2007 3:55pm -0.8 55.34 55.47 54.67 101300
iyg IYG 128.02 3/2/2007 3:56pm -1.68 128.8 129.79 128.02 95500
iyh IYH 65.93 3/2/2007 4:10pm -0.66 66.33 66.691 65.93 76000
iye IYE 96.86 3/2/2007 4:04pm -1.62 98 98.26 96.48 77900
iyr IYR 85.77 3/2/2007 4:15pm -1.81 86.82 87.41 85.77 3777200
iyz IYZ 30.12 3/2/2007 4:15pm -0.34 30.3 30.58 30.12 342800
ige IGE 98.18 3/2/2007 4:16pm -1.92 99.48 99.65 97.85 89400
igm IGM 50.01 3/2/2007 3:59pm -0.82 50.61 50.74 50.01 286500
qqqq QQQQ 42.48 3/2/2007 4:01pm -0.65 42.79 43.14 42.47 183419952
ewj EWJ 14.45 3/2/2007 4:16pm -0.24 14.54 14.58 14.39 31401800
ewy EWY 47.72 3/2/2007 4:15pm -0.41 47.42 48.78 47.42 1956500
ioo IOO 71.37 3/2/2007 3:58pm -0.91 71.87 72.169 71.311 40900
eem EEM 107.96 3/2/2007 4:16pm -1.05 108.05 110.37 107.55 19976076
iev IEV 102.07 3/2/2007 4:15pm -1.35 102.65 103.249 102.06 170100
efa EFA 72.4 3/2/2007 4:16pm -0.99 72.9 73.18 72.34 6951000
ivw IVW 63.25 3/2/2007 4:11pm -0.83 63.5 64.09 63.25 744600
ive IVE 75.72 3/2/2007 4:13pm -1.08 76.6 76.734 75.72 536300
ijk IJK 81.65 3/2/2007 4:03pm -1.19 82.6 82.82 81.46 81600
ijj IJJ 81.37 3/2/2007 4:14pm -1.27 82.68 82.68 81.37 243700
ijt IJT 127.5 3/2/2007 4:14pm -2.44 129.5 129.66 127.5 110100
ijs IJS 74.5 3/2/2007 4:14pm -1.37 75.85 75.85 74.5 236100
gld GLD 63.71 3/2/2007 4:15pm -2.11 64.59 65 63.34 13733200