View Single Post
Old 21-01-2009, 21:41   #2
RubberyDuck
Inactive
 
Join Date: Jan 2009
Location: Essex
Services: Sky HD & XL TV (V+), XXL BB, XL Phone.
Posts: 114
RubberyDuck will become famous soon enoughRubberyDuck will become famous soon enoughRubberyDuck will become famous soon enough
Re: Excel VBA web query problem since new cable connection (text/numbers format probl

This is the code I have for this, it is not mine but may help you.

Sub GetData()

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer, iMax As Integer

Clear

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set DataSheet = ActiveSheet

For iMax = 0 To 1000 Step 200

i = 7 + iMax
If Cells(i, 1) = "" Then
GoTo stopHere
End If

qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
i = i + 1
While Cells(i, 1) <> "" And i < iMax + 207
qurl = qurl + "+" + Cells(i, 1)
i = i + 1
Wend
qurl = qurl + "&f=" + Range("C2")
Range("c1") = qurl

QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("N7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Range("N7:N207").Select
Selection.TextToColumns Destination:=Range("N7"), 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, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1))

Range("N7:W207").Select
Selection.Copy
Cells(7 + iMax, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

' Range("N7:W207").Select
' Selection.ClearContents
Next iMax

ClearNames

'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
' Range("C7:H2000").Select
' Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' Columns("C:C").ColumnWidth = 25.43
' Range("h2").Select



stopHere:
ClearNames
Clear2

End Sub
Sub Clear()

Range("C7:L1200").Select
Selection.ClearContents


End Sub
Sub Clear2()

Columns("N:AA").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select

End Sub


Sub doALL()

Sheets("Yahoo1").Select
GetData

Sheets("Yahoo2").Select
GetData

Sheets("Yahoo3").Select
GetData

End Sub
Sub ClearNames()

With ThisWorkbook
For Each nQuery In Names
If IsNumeric(Right(nQuery.Name, 1)) Then
nQuery.Delete
End If
Next nQuery
End With

End Sub
RubberyDuck is offline   Reply With Quote