Macro to import website data as it changes

[candrews84]

I'm looking for direction on a somewhat tricky request, I realize the advice on this board is free but I would be willing to compensate if someone could assist in fulfilling the request, just PM me.

So I have an Excel template where I am currently entering latitude and longitude data for certain geo-locations that I'm acquiring from a certain website. The issue is that this is a very manual process, I go into the website, enter the location, and then within the certain geo-location I have maybe 5 to 8 different points I'll select individually that then bring up the latitude and longitude for those points as I select them. As I click each point I'm then copying and pasting the lat/long data into my excel template.

In the past I've written macros to pull currency data from currency exchange websites but the data was static and and it was a simple pull of the set data into the excel template. With my current task there is a lot of variability and manual point and click then copy and pasting of the certain geo-locations. I assume a macro could be created to do such a task but my thinking is it would have to be directed to the portion of the html code that is changing (lat/long data) as I click on various locations within the website. There may be a better solution outside of a macro or excel where all the lat/long sets for the points I click are pasted somewhere temporarily that I could then import into Excel but my familiarity is with Excel which is why I'm here.

I realize this board is the foremost authority on Excel so I'm hoping someone could provide advice or as mentioned above I would be willing to compensate if someone would work with me on this in a consulting manner (just PM me). Mods if I've broken any rules in regards to offering compensation please let me know and I will edit the post accordingly or move it to the appropriate place in the forum.

Any and all help is greatly appreciated. And please feel free to ask any questions if the post lacks clarity in regards to the task I'm trying to achieve.

 

[mjbeam]

What website are you getting the coordinates from?

 

[candrews84]

What website are you getting the coordinates from?

Find Latitude and Longitude

Basically I first enter the location info, name of place/area and address then I navigate by ''moving around' the map to find the geographic feature I'm looking for and once I've located it there are usually 5 to 8 different specific locations I will pin and after I place each pin I then copy the lat/long data and paste it into my excel template.

A macro might be more straight forward if I was immediately pinning a location by the search feature but user activity (moving around the map) in my opinion makes this more difficult.

 

[mjbeam]

It looks like it's pretty easy to extract the coordinates from the html at this website. This code checks once a second and if the coordinates of the selected location have changed it dumps the new lat, lon to the active sheet. Here is the code I have so far:

Global coordList As String
Global IE As Object

Sub Start()

    coordList = "|"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://www.findlatitudeandlongitude.com/"
    
    Application.OnTime Now() + TimeValue("00:00:01"), "LookForNewCoord"

End Sub

Public Sub LookForNewCoord()
    
    Application.OnTime Now() + TimeValue("00:00:01"), "LookForNewCoord"

    On Error GoTo notReady
    t = IE.document.DocumentElement.innerHTML
    
    t = Mid(t, InStr(t, "lat=") + 4)
    lat = Left(t, InStr(t, "&") - 1)
    t = Mid(t, InStr(t, ";lon=") + 5)
    lon = Left(t, InStr(t, "&") - 1)
    
    If InStr(coordList, "|" & lat & "," & lon & "|") = 0 Then
        coordList = coordList & lat & "," & lon & "|"
    
        r = 0
        Do
            r = r + 1
            DoEvents
        Loop Until Cells(r, 1) = ""
        
        Cells(r, 1) = lat
        Cells(r, 2) = lon
    End If
    
    Beep
    
    On Error GoTo 0
    
    Exit Sub
    
notReady:
Err.Clear
Exit Sub
    
End Sub

 

[candrews84]

It looks like it's pretty easy to extract the coordinates from the html at this website. This code checks once a second and if the coordinates of the selected location have changed it dumps the new lat, lon to the active sheet. Here is the code I have so far:

Global coordList As String
Global IE As Object

Sub Start()

    coordList = "|"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://www.findlatitudeandlongitude.com/"
    
    Application.OnTime Now() + TimeValue("00:00:01"), "LookForNewCoord"

End Sub

Public Sub LookForNewCoord()
    
    Application.OnTime Now() + TimeValue("00:00:01"), "LookForNewCoord"

    On Error GoTo notReady
    t = IE.document.DocumentElement.innerHTML
    
    t = Mid(t, InStr(t, "lat=") + 4)
    lat = Left(t, InStr(t, "&") - 1)
    t = Mid(t, InStr(t, ";lon=") + 5)
    lon = Left(t, InStr(t, "&") - 1)
    
    If InStr(coordList, "|" & lat & "," & lon & "|") = 0 Then
        coordList = coordList & lat & "," & lon & "|"
    
        r = 0
        Do
            r = r + 1
            DoEvents
        Loop Until Cells(r, 1) = ""
        
        Cells(r, 1) = lat
        Cells(r, 2) = lon
    End If
    
    Beep
    
    On Error GoTo 0
    
    Exit Sub
    
notReady:
Err.Clear
Exit Sub
    
End Sub

I'm unable to test it right now but will this evening. Thank you for looking at this, I'll be in touch and let you know how it works out.

 

[mjbeam]

You will want to move the Beep up to just above the End If statement above it. The beep is to signal when a new coordinate was saved, but it's in the wrong place so it beeps every second instead of just when a new coordinate is found.

 

[candrews84]

You will want to move the Beep up to just above the End If statement above it. The beep is to signal when a new coordinate was saved, but it's in the wrong place so it beeps every second instead of just when a new coordinate is found.

Again thanks mjbeam, I'll adjust the code accordingly and try it out tonight as I'm going through the process. I'll let you know how it works out.

 

[candrews84]

So the code is doing pretty much everything I need my only question is if there is a way to alter the code where I can manually turn on the "LookforNewCoord" portion of the code once I've found the geo-location where I need to tag landmarks? The problem is when I start the macro it logs 3 or 4 different lat/long coordinates as I'm moving around the map to find my specific location.

 

[mjbeam]

Put this in a module. Add 2 buttons to the sheet. Label one button "Start" and link it to the Start sub. Name the second button "Toggle" and link it to the ToggleStatus sub.

Global coordList As String
Global IE As Object
Global destRow, destCol As Integer
Global Watching As Boolean

Sub Start()

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://www.findlatitudeandlongitude.com/"
    Watching = False

End Sub

Public Sub ToggleStatus()

    If Watching = True Then
        Watching = False
        Application.StatusBar = False
    Else
        Watching = True
        destRow = 1
        While Cells(destRow, 2) <> ""
            destRow = destRow + 1
            DoEvents
        Wend
        destCol = 2
        coordList = "|"
        Application.StatusBar = "Logging map coordinates..."
        LookForNewCoord
    End If

End Sub

Public Sub LookForNewCoord()

    If Watching = False Then Exit Sub

    On Error GoTo notReady
    t = IE.Document.DocumentElement.innerHTML
    
    t = Mid(t, InStr(t, "lat=") + 4)
    lat = Left(t, InStr(t, "&") - 1)
    t = Mid(t, InStr(t, ";lon=") + 5)
    lon = Left(t, InStr(t, "&") - 1)
    
    If InStr(coordList, "|" & lat & "," & lon & "|") = 0 Then
        coordList = coordList & lat & "," & lon & "|"
            
        Cells(destRow, destCol) = lat
        Cells(destRow, destCol + 1) = lon
        destCol = destCol + 2
        Beep
    End If
    
    On Error GoTo 0
    
    Application.OnTime Now() + TimeValue("00:00:01"), "LookForNewCoord"
    
    Exit Sub
    
notReady:
Err.Clear
Application.OnTime Now() + TimeValue("00:00:01"), "LookForNewCoord"
Exit Sub
    
End Sub