Mega Code Archive
Building a New Web Query with VBA
<![CDATA[
Sub CreateNewQuery()
Dim WSD As Worksheet
Dim WSW As Worksheet
Dim myQueryTable As QueryTable
Dim FinalRow As Long
Dim i As Integer
Dim ConnectString As String
Dim FinalResultRow As Long
Dim RowCount As Long
Set WSD = Worksheets("Portfolio")
Set WSW = Worksheets("Workspace")
FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To FinalRow
Select Case i
Case 2
ConnectString = "URL;http://finance.Yahoo.com/q/cq?d=v1&s=" & WSD.Cells(i, 1).Value
Case Else
ConnectString = ConnectString & "%2c+" & WSD.Cells(i, 1).Value
End Select
Next i
For Each myQueryTable In WSW.QueryTables
myQueryTable.Delete
Next myQueryTable
Set myQueryTable = WSW.QueryTables.Add(Connection:=ConnectString, _
Destination:=WSW.Range("A1"))
With myQueryTable
.Name = "portfolio"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "11"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With
myQueryTable.Refresh BackgroundQuery:=False
FinalResultRow = WSW.Cells(Rows,Count, 1).End(xlUp).Row
WSW.Cells(1, 1).Resize(FinalResultRow, 7).Name = "WebInfo"
RowCount = FinalRow - 1
WSD.Cells(2, 2).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,3,False)"
WSD.Cells(2, 3).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,4,False)"
WSD.Cells(2, 4).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,5,False)"
WSD.Cells(2, 5).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,6,False)"
WSD.Cells(2, 6).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,2,False)"
End Sub
]]>