VBA URL In Range varies and can be any number of row

Still unsuccessful. Have not got any reply.

Let me try to explain it to you again so that it can be clear. Here are the conditions:
1. sheet1 Column B contains the list of web addresses. The no. of hyperlink is unknown or better to say it can be upto any row no.
2. VBA code will web fetch data from each hyperlink in sheet2 from a table.
3. Table name is common in all sheets but table row number varies.
4. Web table column name need to be appear only once.

Query() 
 
Dim URL As Range 
 
For Each URL In Range ("A1:A10").Cells 
    ActiveWorkbook.Worksheets.Add 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
        "URL;http://www.website.com/" & URL & "secondpartofurl" _ 
        , Destination:=Range("$A$1")) 
        .Name = "placeholder" 
        .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 = "16" 
        .WebPreFormattedTextToColumns = True 
        .WebConsecutiveDelimitersAsOne = True 
        .WebSingleBlockTextImport = False 
        .WebDisableDateRecognition = False 
        .WebDisableRedirections = False 
        .Refresh BackgroundQuery:=False 
    End With 
Next 
End Sub

hi maria
what exactly are you asking to be resolved?
Are you asking how to only check the cells with a url in rather than the whole range?
ie if rows 1 to 8 have url then check those rather than 1 to 10 as in your range?

going out for a couple of hours, but if you tell me what you want i will take a look when im back home

This might do what you want

Sub checkURL()
    Dim URL, MyRange As Range
    Set MyRange = Sheet1.Range("A1:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
    For Each URL In MyRange
        If URL.Value <> "" Then
            ActiveWorkbook.Worksheets.Add
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;http://www.website.com/" & URL & "secondpartofurl" _
                , Destination:=Range("$A$1"))
                .Name = "placeholder"
                .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 = "16"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        End If
    Next
End Sub

Yes. The VBA code is working on first link only and not going to the the 2nd, 3rd, 4th, 5th..... links. I want the output in a single sheet.

Hi, i havent had much experience with web queries but i think you need to add this line after End With

ActiveSheet.QueryTables.Delete

this should delete the current web query before moving onto the next one.

Also are all the URL's in your range actually URL's?

Can you upload a copy of your workbook with URL's?

Hi, sorry as previously mentioned the web query part i dont have much experience with.
If you can give me a bit more info as to what is happening i will try and solve it for you.
Otherwise as i have answered your original question, you may be best to start a new thread regards to your web query problem.

try this

Sub checkURL()
    Dim URL, MyRange As Range
    Set MyRange = Sheet1.Range("A1:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
    For Each URL In MyRange
        If URL.Value <> "" Then
            ActiveWorkbook.Worksheets.Add
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;http://www.website.com/" & URL & "secondpartofurl" _
                , Destination:=Range("$A$1"))
                .Name = "placeholder"
                .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 = "16"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            Call DeleteAllQueries
        End If
    Next
End Sub
Sub DeleteAllQueries() 'breaks quieres 
    Dim qt As QueryTable
    Dim WSh As Worksheet
    
    For Each WSh In ThisWorkbook.Worksheets
    For Each qt In WSh.QueryTables
    qt.Delete
    Next qt
    Next WSh
End Sub

Well i tried the code with 3 different URL address's and it it created 3 new worksheets and andded the data from each URL to seperate sheets.
All worked perfectly ok.
dont understand why yours would be any different.

you did place this sub on the same sheet?

Sub DeleteAllQueries() 'breaks quieres 
    Dim qt As QueryTable
    Dim WSh As Worksheet
    
    For Each WSh In ThisWorkbook.Worksheets
    For Each qt In WSh.QueryTables
    qt.Delete
    Next qt
    Next WSh
End Sub

Hi, glad it finally worked.
I dont have anymore time at the moment, so suggest you mark this as resolved and then start a new thread.

Please add to reputation by using the star symbol.

I want to add another feature to this code: if a web link is not inactive let it go to next link or VBA will stop here.

Hi Maria, try this.
if the web page is not found it will delete all query connections, exit sub and give message as to what URL was not found

Sub checkURL()
    Dim URL, MyRange As Range
    Set MyRange = Sheet1.Range("A1:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
    For Each URL In MyRange
        If URL.Value <> "" Then
            ActiveWorkbook.Worksheets.Add
            on error goto errorhandler
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;http://www.website.com/" & URL & "secondpartofurl" _
                , Destination:=Range("$A$1"))
                .Name = "placeholder"
                .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 = "16"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            Call DeleteAllQueries
        End If
    Next
    Exit Sub
errorhandler:
    Err.Clear
    Call DeleteAllQueries
    MsgBox URL & " Web page not found",vbinformation, "Error"
End Sub

Sub DeleteAllQueries() 'breaks quieres 
    Dim qt As QueryTable
    Dim WSh As Worksheet
    
    For Each WSh In ThisWorkbook.Worksheets
    For Each qt In WSh.QueryTables
    qt.Delete
    Next qt
    Next WSh
End Sub

You might be able to do something by automating IE or using XMLHTTP.

Wthout the links it's kind of hard to help with that though.

Hi Maria,
i have tried this code.
As long as you list your URL's starting with www. this works fine.
if you add your long URL's which take you direct to the window with the table on this will work

if you need to go through the main page and then need send key entries, this is going to be very difficult.
let me know how you get on. i dont have a great deal of time at the moment but let me know if you have problems.

Sean