Things that are slowing this down

1) You are sending over 7000 individual queries to the web
do you need that many every time?
2) you are not error checking column B prior to sending
blanks and non-ticker symbols still generate web query
3) Combine the two loops at the bottom


Additionally try

Application.screenupdating = false
application.calculation = xlcalculationmanual

"YOUR MAIN CODE HERE"

Application.Calculate

"YOUR 2 formating LOOPS, combined into one HERE"

application.calculation = xlcalculationautomatic
Application.screenupdating = true


"John" wrote:

The following web query tries to pull 7967 stock prices from the internet and
puts them in my excel sheet formated. If the ticker symbol in the excel
sheet is invalid it returns nothing or at least seems to.

I think the spreadsheet is continually refreshing the data because it is
very slow to respond when I open it and just try to scroll down or click on
different cells. I just need to import the data when I want once. Can
somebody tell me if this is the problem and how to solve it? If this isn't
the problem, then what is the problem and how do I solve it?

Private Sub CommandButton1_Click()
Dim qtsQueries As QueryTables
Dim qtQuery As QueryTable
Dim test As String
Dim x As Long
x = 1
For Each cell In Sheet1.Range("b1:b7967")
test = "http://finance.yahoo.com/q?s=" & cell.Value
Set qtsQueries = ActiveSheet.QueryTables
Set qtQuery = qtsQueries.Add _
("URL;" & test, _
Application.Range("c" & x))
With qtQuery
.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 = """yfncsubtit"""
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If .FetchedRowOverflow Then
MsgBox "Your request returned too many results. " _
& "Please refine your search.", vbInformation, "Result Error"
End If
End With
x = x + 1
Next
Sheet1.Columns(3).Delete
For Each cell In Sheet1.Range("c1:c7967")
cell.Value = Right(cell, Len(cell) - IIf(InStr(cell, ":") 0,
InStr(cell, ":") + 1, InStr(cell, ":")))
Next
For Each cell In Sheet1.Range("c1:c7967")
cell.Value = Left(cell, IIf(InStr(cell, " ") 0, InStr(cell, " ") - 1,
InStr(cell, " ")))
Next
End Sub