Getting the data from yahoo

Yahoo has servers wish dish out historical sotck info. The only downide is it's a bit slow. It's easy to figure out how to get it to return exactly what you want so that's good, go to yahoo and find historical stock prices if you want to. This code should go in it's own module, and the details of everything are extremely complicated so I can't explain that.

What the code does overall so far is amazing. You enter the ticker symbols and date ranges and it spits out all the stock info into seperate worksheets, or updates them, and displays a progress bar.

I will eventually include another module to create the watchlist worksheet and manage it so that the program is userfriendly and incredibly powerful, but this is a personal project for now. If you have some coding skill, you could figure out what to do.

There actually are some supporting modules as well so here's the code:

Module 1:
Sub getyahoo()

' getyahoo Macro
' Macro recorded 4/26/2008 by Brian
'
Dim I As Integer
Dim TickerCount As Integer
Dim A As Integer

' Check if the sheet to be made already exists
Sheets("Watchlist").Select
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
TickerCount = Selection.Count
For A = 1 To TickerCount
I = 0

Load ProgressForm
PctDone = A / TickerCount
With ProgressForm
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
ProgressForm.Show vbModeless
DoEvents

If A = TickerCount Then Unload ProgressForm

On Error Resume Next
If Sheets(Sheets("Watchlist").Range("A" & A + 2).Value) Is Nothing Then
On Error GoTo 0
Sheets.Add().Name = Sheets("Watchlist").Range("A" & A + 2).Value
entries = DateDiff("d", Worksheets("Watchlist").Range("B2").Value, Worksheets("Watchlist").Range("C2").Value)

End If
'Load in the values from the yahoo servers
Do
Sheets(Sheets("Watchlist").Range("A" & A + 2).Value).Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/hp?s=" & Worksheets("Watchlist").Range("A" & A + 2).Value & "&a=" & Month(Worksheets("Watchlist").Range("B2")) - 1 & "&b=" & Day(Worksheets("Watchlist").Range("B2")) & "&c=" & Year(Worksheets("Watchlist").Range("B2")) & "&d=" & Month(Worksheets("Watchlist").Range("C2")) - 1 & "&e=" & Day(Worksheets("Watchlist").Range("C2")) & "&f=" & Year(Worksheets("Watchlist").Range("C2")) & "&g=d&z=66&y=" & I, _
Destination:=Range("A" & I + 1))

'.Name = "1"
.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 = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
num = I
For Each c In Range("C" & I + 1 & ":C" & I + 67)
num = num + 1
If c.Value = 0 Then Range("A" & num & ":G" & num).Delete Shift:=xlShiftUp
Next
If I > 2 Then Range("A" & I + 1 & ":G" & I + 1).Delete Shift:=xlShiftUp
I = I + 66
Loop Until (I - 66) >= entries
Next A
End Sub

Module2:
Private Function SheetExists(SheetName As String, Optional ByVal WB As Workbook) As Boolean
SheetExists = False
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Workbooks(WB.Name).Sheets(SheetName).Name))
End Function

There is also a userform for the progress bar