Search code examples
excelxmlvbaloops

Loop to import xml from URL based on cell value and report results to a corresponding cell


I have a spreadsheet that builds a URL to query an API. The URLs go into column A on a sheet called "CheckURLs".
When the URL is checked, the xml results go into another sheet called "Results" into column D.

I will have around 500 URLs to check, so want to work out how to loop this.

I can't get the 'Destination' part of the code to offset to another cell - and don't know how to split the function.

The code below is a manual loop through three records.
I would like to make this automatic through all records where there is a value in Sheets("CheckURLs") column A.

Sub Import_Data()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    IIf Sheets("CheckURLs").Range("A2") = "", ExitSub, ThisWorkbook.Sheets("CheckURLs").Activate
    ThisWorkbook.XmlImport Url:=Sheets("CheckURLs").Range("A2").Value, ImportMap:= _
      Nothing, Overwrite:=True, Destination:=Sheets("Results").Range("D2")
    
    IIf Sheets("CheckURLs").Range("A3") = "", ExitSub, ThisWorkbook.Sheets("CheckURLs").Activate
    ThisWorkbook.XmlImport Url:=Sheets("CheckURLs").Range("A3").Value, ImportMap:= _
      Nothing, Overwrite:=True, Destination:=Sheets("Results").Range("D3")
    
    IIf Sheets("CheckURLs").Range("A4") = "", ExitSub, ThisWorkbook.Sheets("CheckURLs").Activate
    ThisWorkbook.XmlImport Url:=Sheets("CheckURLs").Range("A4").Value, ImportMap:= _
      Nothing, Overwrite:=True, Destination:=Sheets("Results").Range("D4")
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Solution

  • One of the missing pieces would be the Worksheet.Cells property. This lets you specify a cell using numbers for the row and column, like this way of specifying cell A2:

    Sheets("CheckURLs").Cells(2, 1)
    

    If we then use a variable for the row part, then we can see how we could loop things:

    Dim lngRow As Long
    lngRow = 2
    
    IIf Sheets("CheckURLs").Cells(lngRow, 1) = ""...
    lngRow = lngRow + 1
    IIf Sheets("CheckURLs").Cells(lngRow, 1) = ""...
    lngRow = lngRow + 1
    

    If we then extract the condition from the IIf calls into a Do...Until loop with the check at the start and we also specify that we are looking at the Value of this cell:

    Dim lngRow As Long
    lngRow = 2
    
    Do Until Sheets("CheckURLs").Cells(lngRow, 1).Value = ""
        ' do stuff
        lngRow = lngRow + 1
    Loop
    

    We no longer need the IIf statements or the "ExitSub" parts or the Activate parts. This gives us:

    Dim lngRow As Long
    lngRow = 2
    
    Do Until Sheets("CheckURLs").Cells(lngRow, 1).Value = ""
        ThisWorkbook.XmlImport Url:=Sheets("CheckURLs").Cells(lngRow, 1).Value, ImportMap:= _
            Nothing, Overwrite:=True, Destination:=Sheets("Results").Cells(lngRow, 4)
        lngRow = lngRow + 1
    Loop
    

    We can still make things better by looking at how we are specifying the worksheets we are working with. Because we have two separate places where we refer to Sheets("CheckURLs") that opens up the potential that any future changes could update one reference but not the other.

    If instead we create variables for each worksheet then we only need to specify the actual worksheet once. This makes it easier to change in future. We can also specify that these worksheets are in the same workbook as the code (i.e. ThisWorkbook) and we can specify that they are Worksheets rather than any other kind of sheet. Note that we need to use Set here because they are object variables. This gives us:

    Dim lngRow As Long
    lngRow = 2
    
    Dim wsCheck As Worksheet
    Set wsCheck = ThisWorkbook.Worksheets("CheckURLs")
    
    Dim wsResult As Worksheet
    Set wsResult = ThisWorkbook.Worksheets("Results")
    
    Do Until wsCheck.Cells(lngRow, 1).Value = ""
        ThisWorkbook.XmlImport Url:=wsCheck.Cells(lngRow, 1).Value, ImportMap:= _
            Nothing, Overwrite:=True, Destination:=wsResult.Cells(lngRow, 4)
        lngRow = lngRow + 1
    Loop