View Full Version : Loop web query
theta
03-31-2011, 05:29 AM
Hi All...
I have a range C7: D12.
C7:C12 contains a URL and D7: D12 contains a generic name.
The are both named ranges (URLs and NAMEs).
I need macro that will loop through each Rng in URLs and...create a new tab using the adjacent NAMEs value, and on this new tab run a web query using the URL value...
This loop will solve a huge problem I have been facing, and can then build a summary
?
mdmackillop
03-31-2011, 05:35 AM
Sub AddSheets()
Dim cel As Range
For Each cel In Range("C7:C12")
Sheets.Add
ActiveSheet.Name = cel.offset(,1)
Call MyQuery(cel)
Next
End Sub
Sub MyQuery(cel)
'Your query
End Sub
theta
03-31-2011, 05:51 AM
Got it working, just need to edit the macro (in the most efficient way) to delete the sheet if it already exists...then create.
Prefer this method to get rid of any stale sheets (that peeps may have fiddled with)
?
theta
03-31-2011, 05:57 AM
Also, I know i'm moving the goalposts here. Is there any way of using the named ranges
URLs and NAMEs
Couldn't really use the cel.offset then, would have to be cel.Row and use this to select the corresponding cell in NAMEs?
This would allow me to place them apart, but aligned on the same row
many thanks
theta
03-31-2011, 06:36 AM
Guessing the range URLs will be passed as a variant along with the NAMEs, then compared to ensure they both have the same dimensions? (UBound)
For i = 0 to UBound(array)
SheetName = array(i)
QueryURL = array2(i)
Create the sheet and query
Next i
I am very new to arrays (and VBA) so while I can understand the concept I am not sure on the best way to code this? It would give me more flexibility as I could place the ranges apart
Kenneth Hobs
03-31-2011, 08:13 AM
Option Explicit
Option Base 0
'http://www.vbaexpress.com/forum/showthread.php?t=36830
Sub AddSheets()
Dim element As Variant, aURLs() As Variant, aNames() As Variant
Dim wsName As String, i As Long
aURLs() = WorksheetFunction.Transpose(Range("URLs"))
aNames() = WorksheetFunction.Transpose(Range("Names"))
Application.DisplayAlerts = False
For i = LBound(aURLs) To UBound(aURLs)
If WorkSheetExists(CStr(aNames(i))) Then Worksheets(aNames(i)).Delete
Sheets.Add
ActiveSheet.Name = aNames(i)
MyQuery CStr(aURLs(i))
Next i
Application.DisplayAlerts = True
End Sub
Sub MyQuery(urlString As String)
MsgBox urlString
'Your query. Delete or comment out MsgBox above.
End Sub
'WorkSheetExists in activeworkbook:
Function WorkSheetExists(aSheetName As String) As Boolean
Dim ws As Worksheet
On Error GoTo notExists
Set ws = Worksheets(aSheetName)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function
theta
04-04-2011, 03:57 AM
Hmmm gives me an error when I try to use urlString within the query (1004 object error)
Option Explicit
Option Base 0
'http://www.vbaexpress.com/forum/showthread.php?t=36830
Sub AddSheets()
Dim element As Variant, aURLs() As Variant, aNames() As Variant
Dim wsName As String, i As Long
aURLs() = WorksheetFunction.Transpose(Range("URLs"))
aNames() = WorksheetFunction.Transpose(Range("Names"))
Application.DisplayAlerts = False
For i = LBound(aURLs) To UBound(aURLs)
If WorkSheetExists(CStr(aNames(i))) Then Worksheets(aNames(i)).Delete
Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = aNames(i)
MyQuery CStr(aURLs(i))
Next i
Application.DisplayAlerts = True
End Sub
Sub MyQuery(urlString As String)
'MsgBox urlString
With ActiveSheet.QueryTables.Add(Connection:= _
urlString _
, Destination:=Range("$D$1"))
.Name = _
urlString
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingRTF
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
'WorkSheetExists in activeworkbook:
Function WorkSheetExists(aSheetName As String) As Boolean
Dim ws As Worksheet
On Error GoTo notExists
Set ws = Worksheets(aSheetName)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function
Kenneth Hobs
04-04-2011, 06:56 AM
Obviously, VBA is showing where your problem is at. You forgot to append the "URL;" and the use of "_". I don't really care for the local named range to be the urlString. I added the namesString for that. In this example, I also set the named ranges for urls and names. You can uncomment the other and comment or delete those two lines.
Option Explicit
Option Base 0
Sub AddSheets()
Dim element As Variant, aURLs() As Variant, aNames() As Variant
Dim wsName As String, i As Long
'aURLs() = WorksheetFunction.Transpose(Range("URLs"))
'aNames() = WorksheetFunction.Transpose(Range("Names"))
aURLs() = WorksheetFunction.Transpose(Range("A2", Range("A2").End(xlDown)))
aNames() = WorksheetFunction.Transpose(Range("B2", Range("B2").End(xlDown)))
Application.DisplayAlerts = False
For i = LBound(aURLs) To UBound(aURLs)
If WorkSheetExists(CStr(aNames(i))) Then Worksheets(aNames(i)).Delete
Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = aNames(i)
MyQuery CStr(aURLs(i)), CStr(aNames(i))
Next i
Application.DisplayAlerts = True
End Sub
Sub MyQuery(urlString As String, nameString As String)
'MsgBox urlString
With ActiveSheet.QueryTables.Add(Connection:="URL;" & urlString, _
Destination:=Range("$D$1"))
.Name = nameString
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingRTF
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
'WorkSheetExists in activeworkbook:
Function WorkSheetExists(aSheetName As String) As Boolean
Dim ws As Worksheet
On Error GoTo notExists
Set ws = Worksheets(aSheetName)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.