Parse text file or xml into listboxes

[ice_531]

Any suggestions the fastest method for pulling a text file or XML file based on the following information. It's preferable that I get the items into list boxes, though i think this may be the part that's slowing it down so poorly.

text file is around 5MB in size. format is as follows, since its from an XML file...there are tags.

<ZipCode>
    <Longitude>-86.502492</Longitude>
    <Latitude>33.606379</Latitude>
    <Code>35004</Code>
    <State>AL</State>
  </ZipCode>
  <ZipCode>
    <Longitude>-86.95969</Longitude>
    <Latitude>33.592585</Latitude>
    <Code>35005</Code>
    <State>AL</State>
  </ZipCode>
  <ZipCode>
    <Longitude>-87.239578</Longitude>
    <Latitude>33.451714</Latitude>
    <Code>35006</Code>
    <State>AL</State>
  </ZipCode>
  <ZipCode>
    <Longitude>-86.808715</Longitude>
    <Latitude>33.232422</Latitude>
    <Code>35007</Code>
    <State>AL</State>
  </ZipCode>

Any suggestions on the best method to do the following based on contents above of the file i'm reading in.


List 1 - Should contain all of the Zip code values within the <code> tags.

List 2 - should contain all the longitude values for that zip code.

List 3 - should contain all the latitude values for that zip code.


I've read up on different methods of serializing/deserializing xml files, but all of it seemed to be .NET. Surely there is a somewhat effecient way to just read in as a text file in the above format, and somehow mid/split to grab out the lat/long/zip into separate listboxes.

Any help would be appreciated. Thanks!

This all stemmed from my previous thread: http://www.vbforums.com/showthread.php?t=653834

Made a new topic for this as that one is solved already.

[Spoo]

Ice

There seem to 2 main issues here

1. Reading the file
2. Parsing the file

Plus a question -- how often will you be doing this?

• Just once
• Many times, on demand?

Assuming that it is a TXT file, then perhaps it would be
faster to read it into an array.

• This would have a "row" for each zip code (List 1)
• If there are multiple longitudes for a given zip code, you'd have a
  several "rows" for a given zip code, each with a unique longitude. If they
  do not appear already "grouped" sequentially in your file, then a supplemental
  sorting of the array could quickly take care of that.

So, where would you like some help?

Spoo

[MarkT]

Here is a quick sample of how to read the xml into listboxes. I have no idea how it would do with a 5mb file.

Option Explicit
' Set a reference to Microsoft XML, vX.x
' In this exmample is used Microsoft XML, v3.0

Private Function GetXml() As String
Dim strXML(25) As String

    strXML(0) = "<ZipCodes>"
    strXML(1) = "<ZipCode>"
    strXML(2) = "<Longitude>-86.502492</Longitude>"
    strXML(3) = "<Latitude>33.606379</Latitude>"
    strXML(4) = "<Code>35004</Code>"
    strXML(5) = "<State>AL</State>"
    strXML(6) = "</ZipCode>"
    strXML(7) = "<ZipCode>"
    strXML(8) = "<Longitude>-86.95969</Longitude>"
    strXML(9) = "<Latitude>33.592585</Latitude>"
    strXML(10) = "<Code>35005</Code>"
    strXML(11) = "<State>AL</State>"
    strXML(12) = "</ZipCode>"
    strXML(13) = "<ZipCode>"
    strXML(14) = "<Longitude>-87.239578</Longitude>"
    strXML(15) = "<Latitude>33.451714</Latitude>"
    strXML(16) = "<Code>35006</Code>"
    strXML(17) = "<State>AL</State>"
    strXML(18) = "</ZipCode>"
    strXML(19) = "<ZipCode>"
    strXML(20) = "<Longitude>-86.808715</Longitude>"
    strXML(21) = "<Latitude>33.232422</Latitude>"
    strXML(22) = "<Code>35007</Code>"
    strXML(23) = "<State>AL</State>"
    strXML(24) = "</ZipCode>"
    strXML(25) = "</ZipCodes>"
    
    GetXml = Join(strXML)
End Function

Private Sub Form_Load()
Dim objDoc As MSXML2.DOMDocument
Dim objNodeList As IXMLDOMNodeList
Dim objNode As IXMLDOMNode
Dim oNode As IXMLDOMNode

    'Create the xml document object and fill it with your xml
    Set objDoc = New MSXML2.DOMDocument
    objDoc.loadXML GetXml
    'objDoc.Load <xml file path>    ' <-- Use the load method to Load the xml from
                                    '   a file instead of an xml string
                                    
    'Fill a node list with all the zip code nodes
    Set objNodeList = objDoc.selectNodes("//ZipCode")
    
    'Loop through the node list and fill the listboxes
    For Each objNode In objNodeList
        'Get the zip code
        Set oNode = objNode.selectSingleNode("Code")
        lstZip.AddItem oNode.Text
        
        'Get the Longitude
        Set oNode = objNode.selectSingleNode("Longitude")
        lstLong.AddItem oNode.Text
        
        'Get the Latitude
        Set oNode = objNode.selectSingleNode("Latitude")
        lstLat.AddItem oNode.Text
    Next

    'clean up
    Set objNodeList = Nothing
    Set objDoc = Nothing
    
End Sub

[ice_531]

Here is a quick sample of how to read the xml into listboxes. I have no idea how it would do with a 5mb file.

Option Explicit
' Set a reference to Microsoft XML, vX.x
' In this exmample is used Microsoft XML, v3.0

Private Function GetXml() As String
Dim strXML(25) As String

    strXML(0) = "<ZipCodes>"
    strXML(1) = "<ZipCode>"
    strXML(2) = "<Longitude>-86.502492</Longitude>"
    strXML(3) = "<Latitude>33.606379</Latitude>"
    strXML(4) = "<Code>35004</Code>"
    strXML(5) = "<State>AL</State>"
    strXML(6) = "</ZipCode>"
    strXML(7) = "<ZipCode>"
    strXML(8) = "<Longitude>-86.95969</Longitude>"
    strXML(9) = "<Latitude>33.592585</Latitude>"
    strXML(10) = "<Code>35005</Code>"
    strXML(11) = "<State>AL</State>"
    strXML(12) = "</ZipCode>"
    strXML(13) = "<ZipCode>"
    strXML(14) = "<Longitude>-87.239578</Longitude>"
    strXML(15) = "<Latitude>33.451714</Latitude>"
    strXML(16) = "<Code>35006</Code>"
    strXML(17) = "<State>AL</State>"
    strXML(18) = "</ZipCode>"
    strXML(19) = "<ZipCode>"
    strXML(20) = "<Longitude>-86.808715</Longitude>"
    strXML(21) = "<Latitude>33.232422</Latitude>"
    strXML(22) = "<Code>35007</Code>"
    strXML(23) = "<State>AL</State>"
    strXML(24) = "</ZipCode>"
    strXML(25) = "</ZipCodes>"
    
    GetXml = Join(strXML)
End Function

Private Sub Form_Load()
Dim objDoc As MSXML2.DOMDocument
Dim objNodeList As IXMLDOMNodeList
Dim objNode As IXMLDOMNode
Dim oNode As IXMLDOMNode

    'Create the xml document object and fill it with your xml
    Set objDoc = New MSXML2.DOMDocument
    objDoc.loadXML GetXml
    'objDoc.Load <xml file path>    ' <-- Use the load method to Load the xml from
                                    '   a file instead of an xml string
                                    
    'Fill a node list with all the zip code nodes
    Set objNodeList = objDoc.selectNodes("//ZipCode")
    
    'Loop through the node list and fill the listboxes
    For Each objNode In objNodeList
        'Get the zip code
        Set oNode = objNode.selectSingleNode("Code")
        lstZip.AddItem oNode.Text
        
        'Get the Longitude
        Set oNode = objNode.selectSingleNode("Longitude")
        lstLong.AddItem oNode.Text
        
        'Get the Latitude
        Set oNode = objNode.selectSingleNode("Latitude")
        lstLat.AddItem oNode.Text
    Next

    'clean up
    Set objNodeList = Nothing
    Set objDoc = Nothing
    
End Sub

Thanks for the code sample.

This method works just fine, it takes 60 seconds on average for it to load the 5mb xml file into the lists though.

Any ways to optimize that code any for speed, or switching to arrays instead of the list boxes?

This was the same problem I was running into trying to just read data as a text file instead of XML. This way is still easier to separate the data with your code snippet above. Just need to speed up the process a lot.

The file could be loaded multiple times during usage if i clear out the data for memory purposes. So it would be nice to have a smooth load time and searches as well.

[Spoo]

The file could be loaded multiple times during usage if i clear out the data for memory purposes. So it would be nice to have a smooth load time and searches as well.

Ice

Seems like it would be appropriate to do a 1-time
read of your TXT/HTML file and then put it into a
database, such as Access.

Thereafter, searches would essentially be instantaneous

Spoo

[Doogle]

You might see some performance improvements using SendMessage toadd the items to the listboxes
eg

Option Explicit

Private Const LB_ADDSTRING = &H180
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                 ByVal wMsg As Long, _
                 ByVal wParam As Long, _
                 lParam As Any) As Long
Private lngRet As Long

    'Loop through the node list and fill the listboxes
    For Each objNode In objNodeList
        'Get the zip code
        Set oNode = objNode.selectSingleNode("Code")
        lngRet = SendMessage(lstZip.hwnd, LB_ADDSTRING, 0&, ByVal oNode.Text)
        
        'Get the Longitude
        Set oNode = objNode.selectSingleNode("Longitude")
        lngRet = SendMessage(lstLong.hwnd, LB_ADDSTRING, 0&, ByVal oNode.Text)
        
        'Get the Latitude
        Set oNode = objNode.selectSingleNode("Latitude")
        lngRet = SendMessage(lstLat.hwnd, LB_ADDSTRING, 0&, ByVal oNode.Text)
    Next

[ice_531]

Ice

Seems like it would be appropriate to do a 1-time
read of your TXT/HTML file and then put it into a
database, such as Access.

Thereafter, searches would essentially be instantaneous

Spoo

That probably is a good idea. It would still require that 1-time load at start that takes over a minute. Guess the app could start with system start-up in the system tray, would take away that aspect I guess.

[ice_531]

You might see some performance improvements using SendMessage toadd the items to the listboxes
eg

Option Explicit

Private Const LB_ADDSTRING = &H180
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                 ByVal wMsg As Long, _
                 ByVal wParam As Long, _
                 lParam As Any) As Long
Private lngRet As Long

    'Loop through the node list and fill the listboxes
    For Each objNode In objNodeList
        'Get the zip code
        Set oNode = objNode.selectSingleNode("Code")
        lngRet = SendMessage(lstZip.hwnd, LB_ADDSTRING, 0&, ByVal oNode.Text)
        
        'Get the Longitude
        Set oNode = objNode.selectSingleNode("Longitude")
        lngRet = SendMessage(lstLong.hwnd, LB_ADDSTRING, 0&, ByVal oNode.Text)
        
        'Get the Latitude
        Set oNode = objNode.selectSingleNode("Latitude")
        lngRet = SendMessage(lstLat.hwnd, LB_ADDSTRING, 0&, ByVal oNode.Text)
    Next

I'll give it a try later and do some timed tests to see. It may speed up some.

thanks for the idea.

[si_the_geek]

That probably is a good idea. It would still require that 1-time load at start that takes over a minute. Guess the app could start with system start-up in the system tray, would take away that aspect I guess.

Does that mean that the text file gets replaced/updated regularly?

If not, switching permanently to a database would be a good move.

[Spoo]

That probably is a good idea. It would still require that 1-time load at start that takes over a minute. Guess the app could start with system start-up in the system tray, would take away that aspect I guess.

Ice

Perhaps I don't fully understand your situation... how often does the source
TXT/HTML file change?

• If it never changes, then you're home free -- just use the database
  (of course, after you have done a one-time "build").
• If it changes once a month, then you can probably live with the
  1-minute "update" time to refresh the database.
• If it changes daily, well, then perhaps you're stuck

I see that Si had a similar thought

Spoo

[ice_531]

The XML file is a one time deal, unless i notice that the US Census Bureau updates the zip codes.

I guess that would be the best method...just extract the information now and place into a database file.

that should increase the performance immensely..when pulling from the database instead.


The other data i use in my app from excel sheets are on a daily basis...or anytime the user runs the app...as that constantly changes. However, that portion is fine and only takes 4-5 seconds to run.

[ice_531]

So I haven't worked with an access DB in years. Was rough working on the syntax for what i have so far. I have my load functions fine for later in my app to load the fields into lists.

However, my problem right now seems to be populating the database with my XML data from my listboxes.

Getting the following error.

"Data type mismatch in criteria expression"

The same code works fine, if i manually enter test data into the listboxes but not with the data from the listboxes once all the XML stuff is loaded. my datatypes are correct in the database.

DB Structure:

zipData - table
Zipcodes - column1 - datatype: Text
Longitude - column2 - datatype: Numeric (double)
Latitude - column3 - datatype: Numeric (double)

Zipcodes is set to Text, because it can contain letters also for a few zipcodes, and most Canadian codes contain letters.

The only thing I've noticed that is difference....is when my XML data is loaded into the listboxes, msbox lstZip.listcount returns -32303

could that be the issue? with their being so much data?

I tried different methods to step through it.

for i = 0 to lstZip.listcount - 1
do stuff
next i

and also

for i = lstZip.listcount -1 to 0 step -1
do stuff
next i


doesnt seem to matter really.

Here goes pieces of code im testing.

private function LoadDatabase()
Dim i As Integer
Dim MyConn As ADODB.Connection
Set MyConn = New ADODB.Connection


MyConn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mypath\zipcodes.mdb;Persist Security Info=False"

For i = 0 To lstZip.ListCount - 1
MyConn.Execute ("INSERT INTO zipData (Zipcodes, Longitude, Latitude) VALUES ('" & lstZip.List(i) & "', '" & lstLong.List(i) & "', '" & lstLat.List(i) & "')")
Next i

MyConn.Close
Set MyConn = Nothing
end function

Any ideas where the problem is coming from? I don't think its the loaddatabase function code, since it works fine for small test data that i load manually into the listboxes...like 10 items per listbox. Only seems to be an issue for the XML data when theres tons of items in the listboxes.

[ice_531]

I can upload the actual XML file and my project if that would help. Not sure if I'm explaining things well enough or not.


Also to add to my post above...

the -32303 list count on my listboxes..... doesnt VB support integers from -32,768 to 32,767 ? So it would seem the 32303 is with in range of the lists.

[Doogle]

When entering Numeric Values into a Table you shouldn't enclose them in quotes

For i = 0 To lstZip.ListCount - 1
MyConn.Execute ("INSERT INTO zipData (Zipcodes, Longitude, Latitude) VALUES ('" & lstZip.List(i) & "', " & lstLong.List(i) & ","  & lstLat.List(i) & ")")
Next i

The other problem you're having / going to have is the limitation of the ListIndex property of a ListBox. It is an Integer value and therefore can have a maximum value of 32,767, after that it will go negative, when it gets to the 65,538th item it will go back to zero and then continue with positive values until it 'wraps' round again. Items beyond 65,537 will be 'unreachable'.

I suspect you've got 100's of 1000's so I don't think a ListBox (or ComboBox) is necessarily the right way to approach this.

I'd load the database directly from .MarkT's code and then, perhaps split the Zip Code into sections (if that's appropriate.

Over here we have PostCodes and the 'general' form is something like CM9 6AZ where the 'CM9 6' defines the Town and County and the 'AZ' defines the Streets. So, in this example CM9 6 defines Maldon in Essex and AZ defines Norfolk Road.

You might wish to consider having two tables, one representing the 'Town / County' and another which holds, for each 'Town and County', the rest of the Zip code and Lat and Long.

[Doogle]

Perhaps it would help if you could explain what sort of user interaction with the data you are expecting to support. If it's just a simple 'what's the Lat and Long of this Zip code?' then all you need is a TextBox for the user to enter the code and a simple look-up in the table. If it's more complicated than that I'm sure we can suggest 'suitable' methods for the user interface.

[ice_531]

Guess I will scrap the list boxes entirely and load the XML directly into the database, as suggested.


@ Doogle

This feature of the application is basically a way to Sort a list of companies which all have zip codes associated with them. The sort is by distance, so that my listview will re-order them based on shortest distance to furthest....from what zipcode the user enters.

There may be 500+ companies in the list at a time, unless the user has already sorted by State in which case, there could just be 20 or so.


So basically, I need to store all of my zip codes / lat/ long in the database. and load them into my app when the user does the sort by zip. so that i can compare the zip codes with their lat/long to get the distance between user zip and each of the company zips.

I'm sure this could be achieved by comparing my list of zipcodes from a listbox directly to the list in the database and pulling just those lat/long out into a matching listbox. however im not to that point yet, and havent had time to read enough on ado to do this. at this point id just pull the whole Database and loop through it with a Instr vbcompare statement.

[ice_531]

Per your suggestion Doogle, I successfully loaded the database directly using the xml code from MarkT.

This was definitely faster than the listboxes too. So i guess I should learn a way to search the database properly and scrap my listboxes for when i need to search and compare too.

[Spoo]

Ice

You can search a database very rapidly.

First, you will need to manually create an Index for each "thing"
you might want to search for, such as

• "zip"
• "longitude"
• "latitude"

Then, the following code snippet could be used "on demand".
It is written for DAO. I haven't worked with ADO, but I imagine
that it would be similar.

zip = Text1.Text
RS1.Index = "zip"
RS1.Seek "=", zip
If Not RS1.NoMatch Then
   < you have a match .. do something>
Else
   < no match was found .. do something else >
End If

It assumes the following

• the name of the textbox you enter the desired zipcode is Text1
• the name of your recordset is RS1

Change as required.
You could do similar things for longitude and latitude.

Hope that gives you some ideas.

Spoo

[MarkT]

So i guess I should learn a way to search the database properly and scrap my listboxes for when i need to search and compare too.

What kind of search are you trying to preform? In other words, are you taking a user entry and looking up something based on that? What exactly are you trying to accomplish?

[ice_531]

What kind of search are you trying to preform? In other words, are you taking a user entry and looking up something based on that? What exactly are you trying to accomplish?

Well... as the previous posts show my Database table consists of the 3 columns.

Zipcodes | Longitude | Latitude

I need to search the database for a zipcode that will be provided by the user from a text box. Once that zip code is found in the database i need to return the corresponding longitude and latitude values into 2 variables.

That will be one search that is done.


The other search would have the same principle. But instead of a single text box containing the zip code.. ill be iterating through a listbox of zip codes and gathering their corresponding longitude and latitude values...and placing them into listboxes instead of variables.

This is where ill then be able to use a for loop to sort of run my calculation to get the distance between the user entered zip code and each of the zip codes in the list....and which will allow me to then sort the list by distance in regards to the users zip code.

psuedo code for the above calculation iteration probably would be something like this.

for i = 0 to lstZip.listcount - 1
lstDistance.list(i) = CalculateDistance(userLong.text, userLat.text, lstLongitude.list(i), lstLatitude.list(i))
next i

This is basically what all I hope to accomplish with this feature of the application. Should be good once I get a better understanding of the database portion for searching and returning those long/lat coordinates.

[Doogle]

Here's something you could play with.

Option Explicit
'
' Assumes:
'   Project reference to Microsoft Active Data Objects 2.8
'   TextBox named txtMyZip - contains 'Source' Zip Code
'   ListBox, named lstZip - contains list of Zip Codes
'   ListView, named lv - will contain the Zips, lat, long and distance
'   Database at C:\db7.mdb (change as appropriate)
'   Table of Zips Lat and Long named Zipdata (change as appropriate)
'       Table Cols: Zipcodes, Latitude, Longitude
'
Dim db As ADODB.Connection

Private Sub cmdCalc_Click()
Dim rs As ADODB.Recordset
Dim lvItem As ListItem
Dim dblMyLat As Double
Dim dblMyLong As Double
Dim dblDistance As Double
Dim intI As Integer
Set rs = New ADODB.Recordset
Dim strSQL As String
'
' Find and save 'source' Lat and Long
'
strSQL = "SELECT Latitude, Longitude FROM Zipdata WHERE Zipcodes = '" & txtMyZip.Text & "'"
rs.Open strSQL, db, adOpenStatic, adLockOptimistic
If Not (rs.EOF And rs.BOF) Then
    dblMyLat = rs![Latitude]
    dblMyLong = rs![Longitude]
    rs.Close
    '
    ' For each Zip code in the ListBox
    ' find the Lat and Long
    ' calculate the distance to 'source'
    ' Add details to the Listview
    '
    For intI = 0 To lstZip.ListCount - 1
        Set lvItem = lv.ListItems.Add(, , lstZip.List(intI))
        strSQL = "SELECT Latitude, Longitude FROM Zipdata WHERE Zipcodes = '" & lstZip.List(intI) & "'"
        rs.Open strSQL, db, adOpenStatic, adLockOptimistic
        If Not (rs.EOF And rs.BOF) Then
            dblDistance = CalcDistance(dblMyLat, dblMyLong, rs![Latitude], rs![Longitude])
            lvItem.ListSubItems.Add , , rs![Latitude]
            lvItem.ListSubItems.Add , , rs![Longitude]
            lvItem.ListSubItems.Add , , Format(dblDistance, "0.00")
        Else
            lvItem.ListSubItems.Add , , "NOT FOUND"
        End If
        rs.Close
    Next intI
Else
    MsgBox "Source Zip Code " & txtMyZip.Text & " Not Found"
End If
rs.Close
End Sub

Private Sub Form_Load()
Set db = New ADODB.Connection
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db7.mdb;"
lv.View = lvwReport
lv.ColumnHeaders.Add , , "Zip Code"
lv.ColumnHeaders.Add , , "Latitude"
lv.ColumnHeaders.Add , , "Longitude"
lv.ColumnHeaders.Add , , "Distance"
End Sub

Private Function CalcDistance(dblSLat As Double, dblSLong As Double, dblTLat As Double, dblTLong As Double) As Double
'
' This Function calculates the Great Circle Distance
' in Miles, between two Locations (Haversine Formula)
'
Dim dblR As Double
Dim dblDLat As Double
Dim dblDLong As Double
Dim dblRSLat As Double
Dim dblRTLat As Double
Dim dblCalc As Double
dblDLat = ToRad(dblTLat - dblSLat)
dblDLong = ToRad(dblTLong - dblSLong)
dblRSLat = ToRad(dblSLat)
dblRTLat = ToRad(dblTLat)
dblR = 3959
dblCalc = Sin(dblDLat / 2) * Sin(dblDLat / 2) + Sin(dblDLong / 2) * Sin(dblDLong / 2) _
            * Cos(dblRSLat) * Cos(dblRTLat)
dblCalc = 2 * Atn(Sqr(dblCalc) / Sqr(1 - dblCalc))
CalcDistance = dblCalc * dblR
End Function

Private Function ToRad(dblNumber As Double) As Double
ToRad = dblNumber / 59.29578
End Function

It's not tested (but it compiles). It's been a few hunderd years since I've had to calculate things like this so ......

[ice_531]

Here's something you could play with.

Option Explicit
'
' Assumes:
'   Project reference to Microsoft Active Data Objects 2.8
'   TextBox named txtMyZip - contains 'Source' Zip Code
'   ListBox, named lstZip - contains list of Zip Codes
'   ListView, named lv - will contain the Zips, lat, long and distance
'   Database at C:\db7.mdb (change as appropriate)
'   Table of Zips Lat and Long named Zipdata (change as appropriate)
'       Table Cols: Zipcodes, Latitude, Longitude
'
Dim db As ADODB.Connection

Private Sub cmdCalc_Click()
Dim rs As ADODB.Recordset
Dim lvItem As ListItem
Dim dblMyLat As Double
Dim dblMyLong As Double
Dim dblDistance As Double
Dim intI As Integer
Set rs = New ADODB.Recordset
Dim strSQL As String
'
' Find and save 'source' Lat and Long
'
strSQL = "SELECT Latitude, Longitude FROM Zipdata WHERE Zipcodes = '" & txtMyZip.Text & "'"
rs.Open strSQL, db, adOpenStatic, adLockOptimistic
If Not (rs.EOF And rs.BOF) Then
    dblMyLat = rs![Latitude]
    dblMyLong = rs![Longitude]
    rs.Close
    '
    ' For each Zip code in the ListBox
    ' find the Lat and Long
    ' calculate the distance to 'source'
    ' Add details to the Listview
    '
    For intI = 0 To lstZip.ListCount - 1
        Set lvItem = lv.ListItems.Add(, , lstZip.List(intI))
        strSQL = "SELECT Latitude, Longitude FROM Zipdata WHERE Zipcodes = '" & lstZip.List(intI) & "'"
        rs.Open strSQL, db, adOpenStatic, adLockOptimistic
        If Not (rs.EOF And rs.BOF) Then
            dblDistance = CalcDistance(dblMyLat, dblMyLong, rs![Latitude], rs![Longitude])
            lvItem.ListSubItems.Add , , rs![Latitude]
            lvItem.ListSubItems.Add , , rs![Longitude]
            lvItem.ListSubItems.Add , , Format(dblDistance, "0.00")
        Else
            lvItem.ListSubItems.Add , , "NOT FOUND"
        End If
        rs.Close
    Next intI
Else
    MsgBox "Source Zip Code " & txtMyZip.Text & " Not Found"
End If
rs.Close
End Sub

Private Sub Form_Load()
Set db = New ADODB.Connection
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db7.mdb;"
lv.View = lvwReport
lv.ColumnHeaders.Add , , "Zip Code"
lv.ColumnHeaders.Add , , "Latitude"
lv.ColumnHeaders.Add , , "Longitude"
lv.ColumnHeaders.Add , , "Distance"
End Sub

Private Function CalcDistance(dblSLat As Double, dblSLong As Double, dblTLat As Double, dblTLong As Double) As Double
'
' This Function calculates the Great Circle Distance
' in Miles, between two Locations (Haversine Formula)
'
Dim dblR As Double
Dim dblDLat As Double
Dim dblDLong As Double
Dim dblRSLat As Double
Dim dblRTLat As Double
Dim dblCalc As Double
dblDLat = ToRad(dblTLat - dblSLat)
dblDLong = ToRad(dblTLong - dblSLong)
dblRSLat = ToRad(dblSLat)
dblRTLat = ToRad(dblTLat)
dblR = 3959
dblCalc = Sin(dblDLat / 2) * Sin(dblDLat / 2) + Sin(dblDLong / 2) * Sin(dblDLong / 2) _
            * Cos(dblRSLat) * Cos(dblRTLat)
dblCalc = 2 * Atn(Sqr(dblCalc) / Sqr(1 - dblCalc))
CalcDistance = dblCalc * dblR
End Function

Private Function ToRad(dblNumber As Double) As Double
ToRad = dblNumber / 59.29578
End Function

It's not tested (but it compiles). It's been a few hunderd years since I've had to calculate things like this so ......

Thanks. The SELECT statements was what I was looking for.

That version of the haversine formula is similar to what I was using at first, but found this version of the vincenty formula is more accurate.

Private Function GetDistance(ByVal Latt1 As Single, _
                             ByVal Long1 As Single, _
                             ByVal Latt2 As Single, _
                             ByVal Long2 As Single, _
                             Optional ByVal InputRadians As Boolean) As Single
'Const EARTHRADIUS As Single = 3438 'NMi (Average)
Const EARTHRADIUS As Single = 3959 'mi (Average)
'Const EARTHRADIUS As Single = 6371 'KM (Average)
'Const EARTHRADIUS As Single = 6371000 'M (Average)
Const PI As Single = 3.14159265
Dim n As Single, d As Single, cxd As Single, sxd As Single
Dim sy1 As Single, sy2 As Single, cy1 As Single, cy2 As Single

  If InputRadians = False Then
    d = PI / 180!
    Latt1 = Latt1 * d
    Long1 = Long1 * d
    Latt2 = Latt2 * d
    Long2 = Long2 * d
  End If

  d = Long2 - Long1
  cxd = Cos(d)
  sxd = Sin(d)
  cy1 = Cos(Latt1)
  cy2 = Cos(Latt2)
  sy1 = Sin(Latt1)
  sy2 = Sin(Latt2)
  
  d = (cy2 * sxd)
  n = (cy1 * sy2) - (sy1 * cy2 * cxd)
  n = Sqr(d * d + n * n)
  d = (sy1 * sy2) + (cy1 * cy2 * cxd)
  
  If d <> 0 Then
    GetDistance = Atn(n / d) * EARTHRADIUS
  ElseIf n <> 0 Then
    GetDistance = PI * 0.5! * EARTHRADIUS
  Else
    GetDistance = 0
  End If
  
End Function

So, now I've got my functions done that get my long/lat coordinates and then calculates the distance.

Something I've noticed is how many zip codes arent even in my database....which is amazing with how much is actually in there. Didn't think i'd have to do many manual entries, but what can ya do

My next dilemma seems to be the best way to handle these listboxes im using. Need to sort the lstDistance in order from lowest number to highest and then make sure all my other listboxes get put in order along with that one, since all the element id's should match up. So if lstDistance(3) gets moved to lstDistance(1) then all my other listboxes (3) elements need to get moved to (1) also. etc etc

Once all my listboxes are then re-organized..i can just simply clear my listview and readd the items from my listboxes in their new format based on that distance.

It's a little more complicated since im findin the DB doesnt have all the zip codes. So ill have some lists from the lstLat and lstLong and lstDistance that will have values of "NO DATA" ...soo ill have to just sort those automatically to the end of the listbox. (this will improve over time, as i have time to add to the database manually.)

[Doogle]

Why not just sort the ListView on the Distance Column using the Sorted Property ? The items with "NO DATA" will all congregate together at the top or bottom, depending on whether you use Ascending or Descending.

(Otherwise I can forecast the next Issue you're going to have - how to select the same row in each Listbox when one is selected from one of the other ListBoxes.)

EDIT: Nice algorithm BTW. I remember having to do loads of GC calclations manually using Log and Trig tables and / or a Slide Rule, since Electronic Calculators hadn't yet been invented.

[ice_531]

Why not just sort the ListView on the Distance Column using the Sorted Property ? The items with "NO DATA" will all congregate together at the top or bottom, depending on whether you use Ascending or Descending.

Sorry havent posted on this topic in awhile. My hdd on desktop died and my project wasnt saved anywhere else. So just now got the application rebuilt.

My problem left seems to be the sorting issue by the distance column of the listview.

It's sorting it based on just the first place in the number.

e.g.

12
2
4
55
7

This is how it sorts, which i need it to use the entire number so the above would really be:

2
4
7
12
55

any ideas? Also this way requires the user to sort the listview themselves by actually clicking the column header. I was hoping to automate this process somehow without them needing to do that.

[MarkT]

here is a quick sample using random data

Private Sub Form_Load()
Dim i As Integer
Dim lvItem As ListItem
Dim strTemp As String
Dim intLen As Integer
Dim strFormat As String
Dim intSortColumn As Integer

    Randomize
    
    lv.View = lvwReport
    lv.ColumnHeaders.Add , , "Zip Code"
    lv.ColumnHeaders.Add , , "Latitude"
    lv.ColumnHeaders.Add , , "Longitude"
    lv.ColumnHeaders.Add , , "Distance"
    
    ' Get the index of the column you want to sort
    ' You can probably get the index base on caption
    ' but for ease I just hard coded it.
    intSortColumn = 3
    
    
    ' Add some random data
    For i = 1 To 20
        Set lvItem = lv.ListItems.Add(, , CStr(i))
        lvItem.ListSubItems.Add , , RandomNumber
        lvItem.ListSubItems.Add , , RandomNumber
        lvItem.ListSubItems.Add , , RandomNumber
    Next i
    
    'Sorting is done on the basis of string values so we need to do some work first
    'Find the longest number
    For i = 1 To lv.ListItems.Count
        strTemp = lv.ListItems(i).ListSubItems(intSortColumn).Text
        If Len(strTemp) > intLen Then
            intLen = Len(strTemp)
        End If
    Next i
    
    'Pad the distance text with zeros so all the strings are the same length
    strFormat = String(intLen, "0")
    For i = 1 To lv.ListItems.Count
        strTemp = lv.ListItems(i).ListSubItems(intSortColumn).Text
        strTemp = Format(strTemp, strFormat)
        lv.ListItems(i).ListSubItems(intSortColumn).Text = strTemp
    Next i
    
    ' Sort the column
    lv.SortKey = 3
    lv.Sorted = True
    
    ' Loop through the listview and remove the leading zeros
    For i = 1 To lv.ListItems.Count
        strTemp = lv.ListItems(i).ListSubItems(intSortColumn).Text
        strTemp = Format(Val(strTemp), "#,##0")
        lv.ListItems(i).ListSubItems(intSortColumn).Text = strTemp
    Next i
End Sub

Private Function RandomNumber() As Integer
Dim i As Integer

    i = Int(Rnd() * 32000) + 1
    RandomNumber = i
End Function

[ice_531]

Ill test out that code and see if i can adapt it into my project. thanks

that still beats doing a bubble sort involving 8 listboxes. (speed would be horrible too i think.)

Another issue I've encountered is with the zip codes....for some.

Excel seems to get rid of leading 0s in the columns..which im pulling the data from an excel sheet that is updated some what regularly by someone else.

So my problem is any zip code that starts with a 0 ( eg. 07152) will show in my program as 7152.


psuedo code i came up with would be something like this to address the problem.

If Format(lstZip.List(i), "####") = True Then
lstZip.AddItem Format(oXLSheet.Cells(i, 22), "0####")
Else
lstZip.AddItem oXLSheet.Cells(i, 22)
End If

not sure if format function can be used like this though.

My other option would be to conver the excel sheet to a database and just manually edit those zipcodes that have lost their leading 0.

[MarkT]

all you really need is

lstZip.AddItem Format(oXLSheet.Cells(i, 22), "00000")

No if statement needed

[ice_531]

all you really need is

lstZip.AddItem Format(oXLSheet.Cells(i, 22), "00000")

No if statement needed

Only problem with this is the Canadian zip codes now that i think about it.

that format is more like V2X 8G1 < BC zipcode

So that would be a problem.



Also, having some trouble with your code for sorting. Some of the fields in distance will not be numbers. but the word "Unknown"

until i can get time to update the database with that zipcodes coordinates.

Also all the distances can have different lengths before the decimal place..but always only 2 spots after the decimal place.
e.g.

23.92
120.82
53.77
8723.09

messing around with the code seeing if i can get it to work for me better

[MarkT]

Also, having some trouble with your code for sorting. Some of the fields in distance will not be numbers. but the word "Unknown"

until i can get time to update the database with that zipcodes coordinates.

Changing this block should take care of Unknown

    ' Loop through the listview and remove the leading zeros
    For i = 1 To lv.ListItems.Count
        strTemp = lv.ListItems(i).ListSubItems(intSortColumn).Text
        If InStr(strTemp, "Unknown") Then
            strTemp = "Unknown"
        Else
            strTemp = Format(Val(strTemp), "#,##0")
        End If
        lv.ListItems(i).ListSubItems(intSortColumn).Text = strTemp
    Next i

Also all the distances can have different lengths before the decimal place..but always only 2 spots after the decimal place.
e.g.

23.92
120.82
53.77
8723.09

messing around with the code seeing if i can get it to work for me better

What I posted shouldn't care about the varying lengths.

[MarkT]

Also all the distances can have different lengths before the decimal place..but always only 2 spots after the decimal place.
e.g.

23.92
120.82
53.77
8723.09

messing around with the code seeing if i can get it to work for me better

Actually change this line
strFormat = String(intLen, "0")
to
strFormat = String(intLen, "0") & ".00"

[ice_531]

Actually change this line
strFormat = String(intLen, "0")
to
strFormat = String(intLen, "0") & ".00"

That did the trick. so that portion is working great.

Now just to decide on my zip code issue... guess i could sort the zip codes into separate lists base on which state/province is selected or based on the zipcode having a space in it. those seem to be ideas that would be easier than switching to using a database and doing some manual entry. since id like the app to be self sustaining, and work with whatever data gets put into that excel sheet.

[Doogle]

Also, having some trouble with your code for sorting. Some of the fields in distance will not be numbers. but the word "Unknown"

How about instead of 'Unknown' you put in a value of minus one ? You might have to adjust the leading zero bit to account for the '-' sign (they'd then sort to the top), alternatively you could put a value greater than the radius of the earth (they'd sort to the bottom), then after the sort you could change them to 'Unknown' if required

[ice_531]

Unknown worked fine with code MarkT posted above.

Also resolved the zip code dilemma.

Forgot about the excel .TEXT property.

I guess I should have read the help in excel sooner and figured that out.

Have the leading 0 issue fixed with that now