Loop web query

[theta]

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]

[vba]
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

[/vba]

[theta]

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]

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]

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]

[VBA]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

[/VBA]

[theta]

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]

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.

[VBA]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[/VBA]