|
-
Jul 23rd, 2012, 09:08 PM
#1
Thread Starter
New Member
[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
-
Jul 23rd, 2012, 09:42 PM
#2
Re: Multiple URL's but I don't know how to create a loop
Thread Moved to Office Development.
A good exercise for the Heart is to bend down and help another up...
Please Mark your Thread " Resolved", if the query is solved
MyGear:
★ CPU ★ Ryzen 5 5800X
★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
★ Keyboard ★ TVS Electronics Gold Keyboard
★ Mouse ★ Logitech G502 Hero
-
Jul 24th, 2012, 05:48 AM
#3
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
Last edited by westconn1; Jul 24th, 2012 at 04:23 PM.
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jul 24th, 2012, 06:15 PM
#4
Thread Starter
New Member
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|