VBA Web Query Macro, Offset Multiple Rows Looping

Example
Request from cell A1 yields data into b1:20. A request from a2 yields data into b21:b41.

Problem: I'm trying to get the offset of the data to work, so that for A1, A2, A3 etc, the data is appropriately offset so that it doesn't overwrite any data. I figure this is probably an easy issue to resolve, but I'm having a complete brain fart. Any help is greatly appreciated.

   

'Loop through the URLs to query and copy the retrieved data from the web query sheet
    
    r = 0
    While dataSheetCopyStart.Offset(r, 0).Value <> ""
        
        URL = dataSheetCopyStart.Offset(r, 0).Value
        QT.Parent.UsedRange.Clear
        QT.Connection = "URL;" & URL
                
        With dataSheetCopyStart
            .Offset(r, 1).Value = Now
            .Offset(r, 2).Value = "Requesting..."
            .Range(.Offset(r - 1, 3), .Offset(r - 1, 7)).ClearContents  'Clear data columns D-H on row
        End With
        
        'Catch possible errors from refreshing web query
        
        On Error Resume Next
        
        QT.Refresh BackgroundQuery:=False
        
        If Err.Number = 0 Then
    
            'Successful query - copy selected data from web query sheet to data sheet columns D-H
            
            On Error GoTo 0
            Debug.Print Now; URL & " - Requested OK"
    
            With dataSheetCopyStart.Offset(r + 20, 0)
                .Offset(r, 1).Value = Now
                .Offset(r, 2).Value = "Requested OK"
                .Offset(r, 3).Value = QT.Destination.Range("a3")    'address
                .Offset(r, 4).Value = QT.Destination.Range("a4")    'Address line 1
                .Offset(r, 5).Value = QT.Destination.Range("a5")    'Address line 2
                .Offset(r + 1, 1).Value = Now
                .Offset(r + 1, 2).Value = "Requested OK"
                .Offset(r + 1, 3).Value = QT.Destination.Range("a8")  'address
                .Offset(r + 1, 4).Value = QT.Destination.Range("a9")  'Address line 1
                .Offset(r + 1, 5).Value = QT.Destination.Range("a10")  'Address line 2
                .Offset(r + 2, 1).Value = Now
                .Offset(r + 2, 2).Value = "Requested OK"
                .Offset(r + 2, 3).Value = QT.Destination.Range("a13")  'address
                .Offset(r + 2, 4).Value = QT.Destination.Range("a14")  'Address line 1
                .Offset(r + 2, 5).Value = QT.Destination.Range("a15")  'Address line 2
                .Offset(r + 3, 1).Value = Now
                .Offset(r + 3, 2).Value = "Requested OK"
                .Offset(r + 3, 3).Value = QT.Destination.Range("a18")  'address
                .Offset(r + 3, 4).Value = QT.Destination.Range("a19")  'Address line 1
                .Offset(r + 3, 5).Value = QT.Destination.Range("a20")  'Address line 2
                .Offset(r + 4, 1).Value = Now
                .Offset(r + 4, 2).Value = "Requested OK"
                .Offset(r + 4, 3).Value = QT.Destination.Range("a23")  'address
                .Offset(r + 4, 4).Value = QT.Destination.Range("a24")  'Address line 1
                .Offset(r + 4, 5).Value = QT.Destination.Range("a25")  'Address line 2
                .Offset(r + 5, 1).Value = Now
                .Offset(r + 5, 2).Value = "Requested OK"
                .Offset(r + 5, 3).Value = QT.Destination.Range("a28")  'address
                .Offset(r + 5, 4).Value = QT.Destination.Range("a29")  'Address line 1
                .Offset(r + 5, 5).Value = QT.Destination.Range("a30")  'Address line 2
                .Offset(r + 6, 1).Value = Now
                .Offset(r + 6, 2).Value = "Requested OK"
                .Offset(r + 6, 3).Value = QT.Destination.Range("a33")  'address
                .Offset(r + 6, 4).Value = QT.Destination.Range("a34")  'Address line 1
                .Offset(r + 6, 5).Value = QT.Destination.Range("a35")  'Address line 2
                .Offset(r + 7, 1).Value = Now
                .Offset(r + 7, 2).Value = "Requested OK"
                .Offset(r + 7, 3).Value = QT.Destination.Range("a38")  'address
                .Offset(r + 7, 4).Value = QT.Destination.Range("a39")  'Address line 1
                .Offset(r + 7, 5).Value = QT.Destination.Range("a40")  'Address line 2
                .Offset(r + 8, 1).Value = Now
                .Offset(r + 8, 2).Value = "Requested OK"
                .Offset(r + 8, 3).Value = QT.Destination.Range("a43")  'address
                .Offset(r + 8, 4).Value = QT.Destination.Range("a44")  'Address line 1
                .Offset(r + 8, 5).Value = QT.Destination.Range("a45")  'Address line 2
                .Offset(r + 9, 1).Value = Now
                .Offset(r + 9, 2).Value = "Requested OK"
                .Offset(r + 9, 3).Value = QT.Destination.Range("a48")  'address
                .Offset(r + 9, 4).Value = QT.Destination.Range("a49")  'Address line 1
                .Offset(r + 9, 5).Value = QT.Destination.Range("a50")  'Address line 2
                .Offset(r + 10, 1).Value = Now
                .Offset(r + 10, 2).Value = "Requested OK"
                .Offset(r + 10, 3).Value = QT.Destination.Range("a53")  'address
                .Offset(r + 10, 4).Value = QT.Destination.Range("a54")  'Address line 1
                .Offset(r + 10, 5).Value = QT.Destination.Range("a55")  'Address line 2
                .Offset(r + 11, 1).Value = Now
                .Offset(r + 11, 2).Value = "Requested OK"
                .Offset(r + 11, 3).Value = QT.Destination.Range("a58")  'address
                .Offset(r + 11, 4).Value = QT.Destination.Range("a59")  'Address line 1
                .Offset(r + 11, 5).Value = QT.Destination.Range("a60")  'Address line 2
                .Offset(r + 12, 1).Value = Now
                .Offset(r + 12, 2).Value = "Requested OK"
                .Offset(r + 12, 3).Value = QT.Destination.Range("a63")    'address
                .Offset(r + 12, 4).Value = QT.Destination.Range("a64")    'Address line 1
                .Offset(r + 12, 5).Value = QT.Destination.Range("a65")    'Address line 2
                .Offset(r + 13, 1).Value = Now
                .Offset(r + 13, 2).Value = "Requested OK"
                .Offset(r + 13, 3).Value = QT.Destination.Range("a68")    'address
                .Offset(r + 13, 4).Value = QT.Destination.Range("a69")    'Address line 1
                .Offset(r + 13, 5).Value = QT.Destination.Range("a70")    'Address line 2
                .Offset(r + 14, 1).Value = Now
                .Offset(r + 14, 2).Value = "Requested OK"
                .Offset(r + 14, 3).Value = QT.Destination.Range("a73")   'address
                .Offset(r + 14, 4).Value = QT.Destination.Range("a74")   'Address line 1
                .Offset(r + 14, 5).Value = QT.Destination.Range("a75")   'Address line 2
                .Offset(r + 15, 1).Value = Now
                .Offset(r + 15, 2).Value = "Requested OK"
                .Offset(r + 15, 3).Value = QT.Destination.Range("a78")   'address
                .Offset(r + 15, 4).Value = QT.Destination.Range("a79")   'Address line 1
                .Offset(r + 15, 5).Value = QT.Destination.Range("a80")   'Address line 2
                .Offset(r + 16, 1).Value = Now
                .Offset(r + 16, 2).Value = "Requested OK"
                .Offset(r + 16, 3).Value = QT.Destination.Range("a83")   'address
                .Offset(r + 16, 4).Value = QT.Destination.Range("a84")   'Address line 1
                .Offset(r + 16, 5).Value = QT.Destination.Range("a85")   'Address line 2
                .Offset(r + 17, 1).Value = Now
                .Offset(r + 17, 2).Value = "Requested OK"
                .Offset(r + 17, 3).Value = QT.Destination.Range("a88")   'address
                .Offset(r + 17, 4).Value = QT.Destination.Range("a89")   'Address line 1
                .Offset(r + 17, 5).Value = QT.Destination.Range("a90")   'Address line 2
                .Offset(r + 18, 1).Value = Now
                .Offset(r + 18, 2).Value = "Requested OK"
                .Offset(r + 18, 3).Value = QT.Destination.Range("a93")   'address
                .Offset(r + 18, 4).Value = QT.Destination.Range("a94")   'Address line 1
                .Offset(r + 18, 5).Value = QT.Destination.Range("a95")   'Address line 2
                .Offset(r + 19, 1).Value = Now
                .Offset(r + 19, 2).Value = "Requested OK"
                .Offset(r + 19, 3).Value = QT.Destination.Range("a98")    'address
                .Offset(r + 19, 4).Value = QT.Destination.Range("a99")    'Address line 1
                .Offset(r + 19, 5).Value = QT.Destination.Range("a100")    'Address line 2
                .Offset(r + 20, 1).Value = Now
                .Offset(r + 20, 2).Value = "Requested OK"
                .Offset(r + 20, 3).Value = QT.Destination.Range("a103")    'address
                .Offset(r + 20, 4).Value = QT.Destination.Range("a104")    'Address line 1
                .Offset(r + 20, 5).Value = QT.Destination.Range("a105")    'Address line 2
                
            End With
           
                    
        Else
    
            'Web query error occurred - log the error
            
            Set savedErr = Err
            On Error GoTo 0
            Debug.Print Now; URL & " - Error " & savedErr.Number & " " & savedErr.Description
    
            With dataSheetCopyStart
                .Offset(r, 1) = Now
                .Offset(r, 2) = "Error " & savedErr.Number & " " & savedErr.Description
            
            End With
        
        
        End If
        
        r = r + 1
        
        DoEvents

    Wend

End Sub

You thread title does not comply with Forum rule 1. Please amend it to a more accurate title that describes your question.

1. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.

hi Huey,

EDIT: after amending your thread title...

Can you please upload an example file that shows a "before & after" with explanation of what you want to see?
This would be easier for us (helpers) to understand.

Also, can you please include the start of the sub as well?
It seems that your code is missing the main definition (unless my browser is playing up) - ie what is "dataSheetCopyStart" initially Set as?

Rob

Option Explicit
Sub Get_Web_Data()

    Dim dataSheetCopyStart As Range
    Dim querySheet As Worksheet
    Dim QT As QueryTable
    Dim URL As String
    Dim r As Long, i As Integer
    Dim savedErr As ErrObject
    
    'Sheet usage:
    'Sheet1 - Column A: URLs to be queried, starting in row 2; B: web query time; C: query status;
    '         D-H: data copied from web query retrieved data
    'Sheet3 - web query sheet
    
    Set dataSheetCopyStart = Sheet1.Range("A2")
    Set querySheet = Sheet3
    
    'Delete all queries
    
    With querySheet
        For i = .QueryTables.Count To 1 Step -1
            .QueryTables(i).Delete
        Next
    End With
    
    'Create 'empty' web query
    
    Set QT = querySheet.QueryTables.Add(Connection:="URL;", Destination:=querySheet.Range("A1"))
    With QT
        .Name = "Walmart"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False 'True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "5"
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        '.Refresh BackgroundQuery:=False  'Don't refresh here
    End With

Sorry for breaking the rules.

Here's the rest. I've also attached an example that explains what I would like to see. The color coding matches the link to the data which is extracted from the link.

hi Huey,

Sorry for breaking the rules.

You can fix this, by changing your thread title as requested by Palmetto - perhaps something along the lines of "prevent over-writing data using VBA Offset property".
(it's probably not the best title, but it explains more than "Offset" does)

Rob
ps: I'm off to bed now so hopefully someone else can help you

hi Huey,

I'm not sure if I understand correctly - If I've got it wrong can you please clarify what data is being over-written?
I suspect it is due to the hard-coded ranges for the QT.destination but I'm not sure. If it is for this, hopefully the below will help...
[code]
'before it says
.Offset(r, 3).Value = QT.Destination.Range("a3") 'address
'create another row variable & then use this in the code, in the same way you have already used "r". eg...

dim r1 as long
'...
With Worksheets("blah")
rw1 = .Cells(.Rows.Count, 1).End(xlUp)
end with
'...
'the new variable allows for code like:
                .Offset(r, 3).Value = QT.Destination.Range("a" & rw1) 'address
                .Offset(r, 3).Value = QT.Destination.Range("a" & rw1 +1) 'address
'etc

hth
Rob

hi Huey,

I think it's all wrapped up in this offset section:

            'RB: changed from "r+20,0)" to "r+(r*20),6)" to ensure nothing is over-written
            With dataSheetCopyStart.Offset(r + (r * 20), 6)

but I've included all the code in a file for ease. If you have any more questions after this, please upload your latest file in a new post.

It is not really tested* because I haven't figured out where to change my security settings in Excel 2007 to allow hyperlinks & queries to be followed. *So I cheated & changed the "if err.number = 0 then" test to "<>0" to allow results to be printed to the sheet.

If I'm still on the wrong track let us know, but I'm off to bed soon so hopefully someone else can help out...

hth
Rob