vba web query

[Loreng]

Ultimately I want code to go through a list of mutual funds (in sheet 1 col A) to pull data from morningstar.com and put all the data for each Fund in the row the the symbol is listed in. Example:

symbol_____category____front load____yield____expense___morningstar rating
ithax_____ Large blend____5.5%_______0.0______1.1%________5 star
cwgix ____World Stock____5.75%______2.49%___0.69%_______5 star


I'm starting with Baby steps because I'm very novice and self taught.

So my first step is to create the code to pull the table from the Web then paste the data in sheet 1:

Sub webpull()

Sheets("Sheet2").Select
Range("A1").Select

' web pull
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://quicktake.morningstar.com/FundNet/Snapshot.aspx?Country=USA&pgid=hetopquote&Symbol=cwgix" _
, Destination:=Range("A1"))
.Name = "Snapshot.aspx?Country=USA&pgid=hetopquote&Symbol=cwgix"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "16"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'paste data
Sheets("Sheet1").Select
Range("B3").Select
ActiveCell.FormulaR1C1 = "=Sheet2!RC[-1]"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=Sheet2!RC"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=Sheet2!R[6]C[-1]"
Range("E3").Select
ActiveCell.FormulaR1C1 = "=Sheet2!R[9]C[-4]"
Range("F3").Select
ActiveCell.FormulaR1C1 = "=Sheet2!R[12]C[-5]"
Range("F4").Select

End Sub

My questions are:
1. is there a better way to move the data pulled from the Web to the column on sheet 1?
2. How do I change the query to refrence the stock symbol in sheet 1 A2?
3. How do I create a loop to pull the data for each fund listed in colum A and move the data to the correct column in sheet 1?

Is this clear? I'm in the office, and not allowed to install addins, so I cannot post examples of my spreadsheet.

Thanks for your help!

 

[MorganO]

Something like this might point you in the right direction

Sub webpull()
 
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
Sheets("Sheet2").Select
Range("A1").Select
' web pull
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://quicktake.morningstar.com/FundNet/Snapshot.aspx?Country=USA&pgid=hetopquote&Symbol=" & Sheets("Sheet1").Cells(i - 1, 1).Value _
, Destination:=Range("A1"))
.Name = "Snapshot.aspx?Country=USA&pgid=hetopquote&Symbol=cwgix"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "16"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'paste data
'Sheets("Sheet1").Select
'Range("B3").Select
'ActiveCell.FormulaR1C1 = "=Sheet2!RC[-1]"
'Range("C3").Select
'ActiveCell.FormulaR1C1 = "=Sheet2!RC"
'Range("D3").Select
'ActiveCell.FormulaR1C1 = "=Sheet2!R[6]C[-1]"
'Range("E3").Select
'ActiveCell.FormulaR1C1 = "=Sheet2!R[9]C[-4]"
'Range("F3").Select
'ActiveCell.FormulaR1C1 = "=Sheet2!R[12]C[-5]"
'Range("F4").Select
'BetterPasteData
Sheets("Sheet1").Cells(i, 2).Value = Sheets("Sheet2").Range("A3").Value
Sheets("Sheet1").Cells(i, 3).Value = Sheets("Sheet2").Range("C3").Value
Sheets("Sheet1").Cells(i, 4).Value = Sheets("Sheet2").Range("C9").Value
Sheets("Sheet1").Cells(i, 5).Value = Sheets("Sheet2").Range("A12").Value
Sheets("Sheet1").Cells(i, 6).Value = Sheets("Sheet2").Range("A15").Value
Next
End Sub

Take care.

Owen