[RESOLVED] Multiple URL's but I don't know how to create a loop
This I'm sure is going to be simply to most but I'm just learning VB. I have 'sheet1' that has hundreds of URL's all in column A. What I want to do is to paste the historical prices from the URL's into 'sheet2'. I have the first 4 URL's in a macro but I'd like for it to loop and keep pulling the data from each subsequent URL and pasting it 30 rows below the last one. I hope someone can help, I've worked on this for a long time and I just can't figure it out on my own.
Code:
Sub Import_Historical_Prices()
'
' Import_Historical_Prices Macro
'
'
Sheets("Sheet1").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAA"
Range("A2").Select
Sheets("Sheet2").Select
ActiveSheet.Paste
Range("A2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAA" _
, Destination:=Range("$A$2"))
.Name = "historicdata.aspx?symbol=AAA_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblHistoryTable"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A31").Select
Sheets("Sheet1").Select
ActiveCell.FormulaR1C1 = _
"http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAB"
Range("A3").Select
Sheets("Sheet2").Select
ActiveSheet.Paste
Range("A32").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAB" _
, Destination:=Range("$A$32"))
.Name = "historicdata.aspx?symbol=AAB_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblHistoryTable"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A61").Select
Sheets("Sheet1").Select
ActiveCell.FormulaR1C1 = _
"http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAH"
Range("A4").Select
Sheets("Sheet2").Select
ActiveSheet.Paste
Range("A62").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAH" _
, Destination:=Range("$A$62"))
.Name = "historicdata.aspx?symbol=AAH"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblHistoryTable"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A91").Select
Sheets("Sheet1").Select
ActiveCell.FormulaR1C1 = _
"http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAV"
Range("A5").Select
Sheets("Sheet2").Select
ActiveSheet.Paste
Range("A92").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAV" _
, Destination:=Range("$A$92"))
.Name = "historicdata.aspx?symbol=AAV"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblHistoryTable"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Re: Multiple URL's but I don't know how to create a loop
Thread Moved to Office Development.
Re: Multiple URL's but I don't know how to create a loop
try like
vb Code:
set sht1 = sheets("sheet1")
set sht2 = sheets("sheet2")
lastrow = sht1.cells(sht1.rows.count, 1).end(xlup).row
for rw = 2 to lastrow
With sht2.QueryTables.Add(Connection:= _
"URL;" & sht1.cells(rw, 1).value _
, Destination:=sht2.cells((rw-2) * 30 + 2, 1))
.Name = "historicdata.aspx?symbol=" & right(sht1.cells(rw, 1),3) & "_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblHistoryTable"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
next
i have not tested this at all, you may need to change the calculation for the destination row, if it is not quite as i envision it
i have not made any provision to test if the next querytable will fit on the sheet, as i assume it could outgrow the number of rows in a sheet
Re: [RESOLVED] Multiple URL's but I don't know how to create a loop
Thanks Westconn1,
It looks like it works.
Thanks, I had been working on this way too long.
Q
