Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-30-2017, 07:17 PM
CBirnley CBirnley is offline IF..Then...or Conditional...or Mac OS X IF..Then...or Conditional...or Office 2016
Novice
IF..Then...or Conditional...or
 
Join Date: Apr 2017
Posts: 1
CBirnley is on a distinguished road
Default IF..Then...or Conditional...or

I am attempting to build a spreadsheet to record mileage traveled. My goal is that in cell B2 I would type in a city and then in cell C2 the cell will populate with the amount of miles between my home and that city. I would have the miles figured out ahead of time and ready for use. Your assistance would be greatly appreciated. I am using X2016 on iPad and or PC.
Reply With Quote
  #2  
Old 05-01-2017, 03:26 PM
Logit Logit is offline IF..Then...or Conditional...or Windows 10 IF..Then...or Conditional...or Office 2007
Expert
 
Join Date: Jan 2017
Posts: 587
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

Code:
' Usage :
' GetGoogleTravelTime (strFrom, strTo) returns a string containing journey duration : hh:mm
' GetGoogleDistance (strFrom, strTo) returns a string containing journey distance in either miles or km (as defined by strUnits)
' GetGoogleDirections (strFrom, strTo) returns a string containing the directions
'
' where strFrom/To are address search terms recognisable by Google
' i.e. Postcode, address etc.
'
' by Desmond Oshiwambo

Const strUnits = "imperial" ' imperial/metric (miles/km)

Function CleanHTML(ByVal strHTML)
'Helper function to clean HTML instructions
Dim strInstrArr1() As String
Dim strInstrArr2() As String
Dim s As Integer

strInstrArr1 = Split(strHTML, "<")
For s = LBound(strInstrArr1) To UBound(strInstrArr1)
   strInstrArr2 = Split(strInstrArr1(s), ">")
   If UBound(strInstrArr2) > 0 Then
        strInstrArr1(s) = strInstrArr2(1)
   Else
        strInstrArr1(s) = strInstrArr2(0)
   End If
Next
 
CleanHTML = Join(strInstrArr1)
End Function

Public Function formatGoogleTime(ByVal lngSeconds As Double)
'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm
 
Dim lngMinutes As Long
Dim lngHours As Long
 
lngMinutes = Fix(lngSeconds / 60)
lngHours = Fix(lngMinutes / 60)
lngMinutes = lngMinutes - (lngHours * 60)
 
formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00")
End Function




Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo errorHandler
' Helper function to request and process XML generated by Google Maps.

Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long

Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")
 
strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")
 
strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&sensor=false" & _
            "&units=" & strUnits   'Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request
 
'Send XML request
With objXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .Send
    objDOMDocument.LoadXML .ResponseText
End With
 
With objDOMDocument
    If .SelectSingleNode("//status").Text = "OK" Then
        'Get Distance
        lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters
        Select Case strUnits
            Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1)  'Convert meters to miles
            Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
        End Select
        
        'Get Travel Time
        strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text  'returns in seconds from google
        strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm
        
        'Get Directions
        For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes
            If nodeRoute.BaseName = "step" Then
                strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf
            End If
        Next
        
        strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text.
        
    Else
        strError = .SelectSingleNode("//status").Text
        GoTo errorHandler
    End If
End With
 
gglDirectionsResponse = True
GoTo CleanExit
 
errorHandler:
    If strError = "" Then strError = Err.Description
    strDistance = -1
    strTravelTime = "00:00"
    strInstructions = ""
    gglDirectionsResponse = False
 
CleanExit:
    Set objDOMDocument = Nothing
    Set objXMLHttp = Nothing
 
End Function
 

Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String
'Returns the journey time between strFrom and strTo
 
Dim strTravelTime As String
Dim strDistance As String
Dim strInstructions As String
Dim strError As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleTravelTime = strTravelTime
Else
    getGoogleTravelTime = strError
End If
 
End Function
 
Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
'Returns the distance between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.
 
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDistance = strDistance
Else
    getGoogleDistance = strError
End If
 
End Function

Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String
'Returns the directions between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.
 
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDirections = strInstructions
Else
    getGoogleDirections = strError
End If
 
Public Function GetZone(Milage As String) As Integer
    GetZone = WorksheetFunction.RoundDown(Split(Milage, " ")(2) / 5, 0)
End Function
Attached Files
File Type: xls Milage test.xls (119.0 KB, 13 views)
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
IF..Then...or Conditional...or Conditional formatting otuatail Excel 11 07-11-2016 11:30 PM
IF..Then...or Conditional...or Conditional formatting dayperson Excel 1 02-23-2016 09:07 AM
Conditional Formatting jdc15371 Excel 2 06-26-2014 06:34 AM
conditional formatting otuatail Excel 1 06-06-2012 05:07 AM
Conditional Formula UICOMP Excel 1 05-18-2012 12:59 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:43 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft