Arrays, Ranges and unknown row count

yellowc

New Member
Joined
Feb 27, 2018
Messages
10
Afternoon all,

I've been doing a lot more VBA scripting so I thought I would join to get expert help and hopefully give one day. I've created a macro tha that will use the mapquest api to find the distance between two points. The macro works but I need to make it more dynamic. The main problem is I don't ever know how many rows of data I'm going to be looking up and I'm having a real problem understanding how to make the script run until it hits an empty spot. The next issue is that I pass all the distances into an array but when I post the array into column c the last distance value is always missing. Not sure what's going on with that, Here's my code below.

Code:
Public Sub getdirections()


Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String, c As Range, rng As Range, xmlresponse As New DOMDocument60
Dim myarray() As Variant, x As Long, d As Range


Set rng = Range("c2:c26")




'single substitution to get one location will work on looping in a bit
For Each c In rng
    myurl = "http://www.mapquestapi.com/directions/v2/route?key=key" & c & "&outFormat=xml&ambiguities=ignore&routeType=shortest"
    'Debug.Print myurl
    'sending the request
      xmlhttp.Open "GET", myurl, False
      xmlhttp.Send
      xmlresponse.LoadXML (xmlhttp.ResponseText)
      'once I got XML returns instead of JSON returns all started to work properly
     Set stats = xmlresponse.SelectNodes("//response/route/distance")
     'Sheets(1).Range("e2").Value = stats(0).Text
     ReDim Preserve myarray(x)
     myarray(x) = stats(0).Text
     x = x + 1
    'Range("d2 & rng").Value = stats(0).Text
     If c = "" Then
    Exit For
    End If
Next




For x = LBound(myarray) To UBound(myarray)
    Debug.Print myarray(x)
 Next x


Range("d2:d26").Value = Application.WorksheetFunction.Transpose(myarray)




End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

HackSlash

Active Member
Joined
Nov 18, 2016
Messages
360
For your first problem, let's look at column C and get the last row with data in it:

Code:
LastRowColC = Range("C" & Cells.CountLarge).End(xlUp).Row

Then we will use that to define your dataset up front.

When you don't know how big your array will be you should use a collection:
https://excelmacromastery.com/excel-vba-collections/


I converted your array to collection but I'm not sure if you will actually use it because we can fill in column D as we go along.

Take a look:
Code:
Public Sub getdirections()
    Dim distances As Collection
   
    Dim LastRowColC As Long
    LastRowColC = Range("C" & Cells.CountLarge).End(xlUp).Row
    
    Dim dataSet As Range
    Set dataSet = Range("C2:C" & LastRowColC)

    'single substitution to get one location will work on looping in a bit
    Dim currentCell As Range
    For Each currentCell In dataSet
        If currentCell = "" Then Exit For
        
        Dim xmlhttp As New MSXML2.XMLHTTP60
        Dim xmlresponse As New DOMDocument60
        Dim mapURL As String
        
        mapURL = "http://www.mapquestapi.com/directions/v2/route?key=key" & currentCell & "&outFormat=xml&ambiguities=ignore&routeType=shortest"
        'Debug.Print myurl
        'sending the request
        xmlhttp.Open "GET", mapURL, False
        xmlhttp.Send
        xmlresponse.LoadXML (xmlhttp.ResponseText)
        'once I got XML returns instead of JSON returns all started to work properly
        Set stats = xmlresponse.SelectNodes("//response/route/distance")
        'Sheets(1).Range("e2").Value = stats(0).Text
        
        'Add the text to the collection:
        distances.Add stats(0).Text
        
        Range("D" & currentCell.Row).Value = stats(0).Text
    Next currentCell

    For Each distanceItem In distances
        Debug.Print distanceItem
    Next distanceItem

    'Range("d2:d26").Value = Application.WorksheetFunction.Transpose(distanceItem)
End Sub
 

Forum statistics

Threads
1,148,108
Messages
5,744,873
Members
423,907
Latest member
zerocool88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top